Bulk attachments - can I autolink them?

I have a very long list of Images in a single folder that I want to attach to 
seperate fields in a table/form.

Each record contains two images, which are named like this:

W:\Foldername\Micromap Run 001 A.bmp     =(1st record)
W:\Foldername\Micromap Run 001 B.bmp     =(1st record)
W:\Foldername\Micromap Run 002 A.bmp     =(2nd record)
W:\Foldername\Micromap Run 002 B.bmp     =(2nd record)
W:\Foldername\Micromap Run 003 A.bmp     =(3rd record)
W:\Foldername\Micromap Run 003 B.bmp     =(3rd record)

and so on...

Image A goes to field A
Image B goes to field B


Is there a way of doing this automatically?

The total list of records is 320 (x2 = 640 images)





0
Utf
7/8/2007 7:42:00 AM
access.formscoding 7494 articles. 0 followers. Follow

11 Replies
2680 Views

Similar Articles

[PageSpeed] 32

On Jul 8, 2:42 am, efandango <efanda...@discussions.microsoft.com>
wrote:
> I have a very long list of Images in a single folder that I want to attach to
> seperate fields in a table/form.
>
> Each record contains two images, which are named like this:
>
> W:\Foldername\Micromap Run 001 A.bmp     =(1st record)
> W:\Foldername\Micromap Run 001 B.bmp     =(1st record)
> W:\Foldername\Micromap Run 002 A.bmp     =(2nd record)
> W:\Foldername\Micromap Run 002 B.bmp     =(2nd record)
> W:\Foldername\Micromap Run 003 A.bmp     =(3rd record)
> W:\Foldername\Micromap Run 003 B.bmp     =(3rd record)
>
> and so on...
>
> Image A goes to field A
> Image B goes to field B
>
> Is there a way of doing this automatically?
>
> The total list of records is 320 (x2 = 640 images)

If there's some kind of rule/algorithm you can use to determine which
image goes with which record, then it's easy.  Just use an update
query.

0
pietlinden
7/8/2007 7:42:10 PM
There is Master Field number [Run_no] for each main record that links to the 
images sub table. But how do I get an update query to link a folder path to a 
field name? Also, I can't see how the field name works, it just has a 
paperclip icon for each record field in the sub table?




"pietlinden@hotmail.com" wrote:

> On Jul 8, 2:42 am, efandango <efanda...@discussions.microsoft.com>
> wrote:
> > I have a very long list of Images in a single folder that I want to attach to
> > seperate fields in a table/form.
> >
> > Each record contains two images, which are named like this:
> >
> > W:\Foldername\Micromap Run 001 A.bmp     =(1st record)
> > W:\Foldername\Micromap Run 001 B.bmp     =(1st record)
> > W:\Foldername\Micromap Run 002 A.bmp     =(2nd record)
> > W:\Foldername\Micromap Run 002 B.bmp     =(2nd record)
> > W:\Foldername\Micromap Run 003 A.bmp     =(3rd record)
> > W:\Foldername\Micromap Run 003 B.bmp     =(3rd record)
> >
> > and so on...
> >
> > Image A goes to field A
> > Image B goes to field B
> >
> > Is there a way of doing this automatically?
> >
> > The total list of records is 320 (x2 = 640 images)
> 
> If there's some kind of rule/algorithm you can use to determine which
> image goes with which record, then it's easy.  Just use an update
> query.
> 
> 
0
Utf
7/8/2007 9:22:01 PM
This module will do what you need, I assume you only need the file 
location/hyperlink.  This was not my code to start, I modified it so you 
must keep the author info in the code and revisions out of respect for those 
that share.  Pete

'/==========Code starts here================
Option Compare Database
Option Explicit
'created using John Walkenbach's "Microsoft Excel 2000 Power
'  Programming with VBA" example as a basic starting point
'====================================
'32-bit API declarations
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
  Alias "SHGetPathFromIDListA" (ByVal pidl As Long, _
  ByVal pszPath As String) As Long

Declare Function SHBrowseForFolder Lib "shell32.dll" _
  Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) _
  As Long
'=====================================
Public Type BROWSEINFO
  hOwner As Long
  pidlRoot As Long
  pszDisplayName As String
  lpszTitle As String
  ulFlags As Long
  lpfn As Long
  lParam As Long
  iImage As Long
End Type
'=====================================

Public Function ListFilesToTable()
On Error Resume Next
    'History:
    ' 07/15/2000 added hyperlink
    ' 07/17/2000 added filename filter
    ' 07/20/2000 added # files found info & criteria info
    ' 07/27/2000 added extension as separate column
    ' 08/03/2000 changed # files found to 'count' formula
    ' 10/23/2000 add status bar 'Wait' message
    ' 04/09/2007 Borrowed code from John Walkenbach's to
    ' manage USAF vehicle repair manuals in MS Access Pete Duffy
    Dim MyDB As Database
    Dim MyTable As Recordset
    Dim blnSubFolders As Boolean
    Dim dblLastRow As Double
    Dim i As Integer, r As Integer, x As Integer
    Dim Y As Integer ', iWorksheets As Integer Not needed for Access
    Dim msg As String, Directory As String, strPath As String
    Dim strResultsTableName As String, strFileName As String
    Dim strFileNameFilter As String, strDefaultMatch As String
    Dim strExtension As String, strFileBoxDesc As String
    Dim strMessage_Wait1 As String, strMessage_Wait2 As String
    Dim varSubFolders As Variant
    Dim strHyperlinkItem As Hyperlink
    Dim Files_Found As String
    Dim varStatus As Variant
    Dim SwitchScreenUpdate As Integer
'    I didn't need this for my application
'    Dim CalcFileSize As Long
    '/==========Variables=============
    strResultsTableName = "tbl_LoadHyperLinks" 'Table to store info in
    strDefaultMatch = "*.PDF" 'Change to what you want as default extension
    r = 1
    i = 1
    blnSubFolders = False
    strMessage_Wait1 = "Please wait while search is in progress..."
'   Access doesn't require formating like original Excel version does.
'   strMessage_Wait2 = "Please wait while formatting is completed..."
    '/==========Variables=============
    strFileNameFilter = InputBox("Ex:  *.* with find all files" & vbCr & _
        "     blank will find all Office files" & vbCr & _
        "     *.xls will find all Excel files" & vbCr & _
        "     G*.doc will find all Word files beginning with G" & vbCr & _
        "     Test.txt will find only the files named TEST.TXT" & vbCr, _
        "Enter file name to match:", Default:=strDefaultMatch)

    If Len(strFileNameFilter) = 0 Then
        strFileBoxDesc = "All MSOffice files"
      Else
        strFileBoxDesc = strFileNameFilter
    End If

    msg = "Look for: " & strFileBoxDesc & vbCrLf & _
        " - Select location of files to be listed or press Cancel."
    Directory = GetDirectory(msg)
    If Directory = "" Then Exit Function
    If Right(Directory, 1) <> "\" Then Directory = Directory & "\"

    varSubFolders = _
        MsgBox("Search Sub-Folders of " & Directory & " ?", _
        vbInformation + vbYesNoCancel, "Search Sub-Folders?")
    If varSubFolders = vbYes Then blnSubFolders = True
    If varSubFolders = vbNo Then blnSubFolders = False
    If varSubFolders = vbCancel Then Exit Function
    DoCmd.Hourglass True
'   Access specific I used a form so user doesn't think computer frozen
    DoCmd.OpenForm "frm_PleaseWait", acNormal, "", "", , acNormal
    Forms!frm_PleaseWait.Repaint
    r = r + 1
    On Error Resume Next

    varStatus = SysCmd(acSysCmdSetStatus, strMessage_Wait1)
    Set MyDB = CurrentDb
    Set MyTable = MyDB.OpenRecordset("tbl_LoadHyperLinks")
    With Application.FileSearch
        .NewSearch
        .LookIn = Directory
        '.FileName = "*.*"
        .FileName = strFileNameFilter
        '.SearchSubFolders = False
        .SearchSubFolders = blnSubFolders
        .Execute
        For i = 1 To .FoundFiles.Count
            strFileName = ""
            strPath = ""
            For Y = Len(.FoundFiles(i)) To 1 Step -1
                If Mid(.FoundFiles(i), Y, 1) = "\" Then
                    Exit For
                End If
                strFileName = Mid(.FoundFiles(i), Y, 1) & strFileName
            Next Y
            strPath = Left(.FoundFiles(i), Len(.FoundFiles(i)) - 
Len(strFileName))
            strExtension = ""
            For Y = Len(strFileName) To 1 Step -1
                If Mid(strFileName, Y, 1) = "." Then
                    If Len(strFileName) - Y <> 0 Then
                        strExtension = Right(strFileName, Len(strFileName) - 
Y)
                        strFileName = Left(strFileName, Y - 1)
                        Exit For
                    End If
                End If
            Next Y
            MyTable.AddNew
            MyTable("FileHyperLink") = strPath & strFileName & "#" & 
(.FoundFiles(i)) & "##" & "Open Manual " & strFileName _
            & " file size is " & FileLen(.FoundFiles(i))
            MyTable("FilePath") = strPath
            MyTable("FileFilename") = strFileName
            MyTable("FileExtension") = strExtension
            MyTable("FileSize") = FileLen(.FoundFiles(i))
            MyTable("FileDateTime") = FileDateTime(.FoundFiles(i))
            MyTable.Update
            r = r + 1
            SwitchScreenUpdate = SwitchScreenUpdate + 1
            If SwitchScreenUpdate = 20 Then
                Files_Found = "Writing Record " & r - 1
                Forms!frm_PleaseWait.File_Found.Visible = True
                Forms!frm_PleaseWait.File_Found.Caption = Files_Found
                Forms!frm_PleaseWait.Repaint
                SwitchScreenUpdate = 0
            End If
        Next i
    End With
    MyTable.Close
    Set MyTable = Nothing
    Forms!frm_PleaseWait.File_Found.Visible = False
    DoCmd.Close acForm, "frm_PleaseWait"
    DoCmd.Hourglass False

    If Len(strFileNameFilter) = 0 Then
        strFileNameFilter = "All MSOffice products"
    End If
    If blnSubFolders Then
        Directory = "(including Subfolders) - " & Directory
    End If
Exit_ListFiles:
' Find access equivalent for below.
'    Application.StatusBar = False
    Exit Function
Err_ListFiles:
    MsgBox "Error: " & Err & " - " & Err.Description
    Resume Exit_ListFiles
End Function
'=======================================
Function GetDirectory(Optional msg) As String
    Dim bInfo As BROWSEINFO
    Dim path As String
    Dim r As Long, x As Long, pos As Integer
' Root folder = Desktop
    bInfo.pidlRoot = 0&
' Title in the dialog
    If IsMissing(msg) Then
        bInfo.lpszTitle = "Select a folder."
    Else
        bInfo.lpszTitle = msg
  End If
' Type of directory to return
    bInfo.ulFlags = &H1
' Display the dialog
    x = SHBrowseForFolder(bInfo)
' Parse the result
    path = Space$(512)
    r = SHGetPathFromIDList(ByVal x, ByVal path)
    If r Then
        pos = InStr(path, Chr$(0))
        GetDirectory = Left(path, pos - 1)
    Else
        GetDirectory = ""
  End If
End Function
'===============End Code=================
Function FileSearcher()
On Error Resume Next
    Dim n As Long
    Dim SwitchScreenUpdate As Integer
    Dim Files_Found As String
    With Application.FileSearch
        .LookIn = "\Folderpathfilename\"
        .FileName = "*.*"
        .SearchSubFolders = True
'       Need to update, not needed for current application but will fix 
later
'            If .Execute(SortBy:=msoSortByFilename, 
SortOrder:=msoSortOrderAscending, _
'            alwaysAccurate:=True) > 0 Then
'                For n = 1 To .FoundFiles.Count
'                    Worksheets("Sheet1").Cells(n, "A").Value = 
..FoundFiles(n)
'                     varStatus = SysCmd(acSysCmdInitMeter, strStatus, 
..FoundFiles(n))
'                Next
'            End If
    End With
End Function


"efandango" <efandango@discussions.microsoft.com> wrote in message 
news:AADDB95D-1A74-4F98-A415-AFC8FA30EE2D@microsoft.com...
> There is Master Field number [Run_no] for each main record that links to 
> the
> images sub table. But how do I get an update query to link a folder path 
> to a
> field name? Also, I can't see how the field name works, it just has a
> paperclip icon for each record field in the sub table?
>
>
>
>
> "pietlinden@hotmail.com" wrote:
>
>> On Jul 8, 2:42 am, efandango <efanda...@discussions.microsoft.com>
>> wrote:
>> > I have a very long list of Images in a single folder that I want to 
>> > attach to
>> > seperate fields in a table/form.
>> >
>> > Each record contains two images, which are named like this:
>> >
>> > W:\Foldername\Micromap Run 001 A.bmp     =(1st record)
>> > W:\Foldername\Micromap Run 001 B.bmp     =(1st record)
>> > W:\Foldername\Micromap Run 002 A.bmp     =(2nd record)
>> > W:\Foldername\Micromap Run 002 B.bmp     =(2nd record)
>> > W:\Foldername\Micromap Run 003 A.bmp     =(3rd record)
>> > W:\Foldername\Micromap Run 003 B.bmp     =(3rd record)
>> >
>> > and so on...
>> >
>> > Image A goes to field A
>> > Image B goes to field B
>> >
>> > Is there a way of doing this automatically?
>> >
>> > The total list of records is 320 (x2 = 640 images)
>>
>> If there's some kind of rule/algorithm you can use to determine which
>> image goes with which record, then it's easy.  Just use an update
>> query.
>>
>> 


0
Pete
7/8/2007 9:49:22 PM
Pete,

Thanks for that, I havne't tried it yet, but after reading your response, I 
realised that perhaps I should have mentioned that I am not using hyperlinks, 
but the attachments feature in MS Access 2007. Are you familiar with it?.

"Pete" wrote:

> This module will do what you need, I assume you only need the file 
> location/hyperlink.  This was not my code to start, I modified it so you 
> must keep the author info in the code and revisions out of respect for those 
> that share.  Pete
> 
> '/==========Code starts here================
> Option Compare Database
> Option Explicit
> 'created using John Walkenbach's "Microsoft Excel 2000 Power
> '  Programming with VBA" example as a basic starting point
> '====================================
> '32-bit API declarations
> Declare Function SHGetPathFromIDList Lib "shell32.dll" _
>   Alias "SHGetPathFromIDListA" (ByVal pidl As Long, _
>   ByVal pszPath As String) As Long
> 
> Declare Function SHBrowseForFolder Lib "shell32.dll" _
>   Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) _
>   As Long
> '=====================================
> Public Type BROWSEINFO
>   hOwner As Long
>   pidlRoot As Long
>   pszDisplayName As String
>   lpszTitle As String
>   ulFlags As Long
>   lpfn As Long
>   lParam As Long
>   iImage As Long
> End Type
> '=====================================
> 
> Public Function ListFilesToTable()
> On Error Resume Next
>     'History:
>     ' 07/15/2000 added hyperlink
>     ' 07/17/2000 added filename filter
>     ' 07/20/2000 added # files found info & criteria info
>     ' 07/27/2000 added extension as separate column
>     ' 08/03/2000 changed # files found to 'count' formula
>     ' 10/23/2000 add status bar 'Wait' message
>     ' 04/09/2007 Borrowed code from John Walkenbach's to
>     ' manage USAF vehicle repair manuals in MS Access Pete Duffy
>     Dim MyDB As Database
>     Dim MyTable As Recordset
>     Dim blnSubFolders As Boolean
>     Dim dblLastRow As Double
>     Dim i As Integer, r As Integer, x As Integer
>     Dim Y As Integer ', iWorksheets As Integer Not needed for Access
>     Dim msg As String, Directory As String, strPath As String
>     Dim strResultsTableName As String, strFileName As String
>     Dim strFileNameFilter As String, strDefaultMatch As String
>     Dim strExtension As String, strFileBoxDesc As String
>     Dim strMessage_Wait1 As String, strMessage_Wait2 As String
>     Dim varSubFolders As Variant
>     Dim strHyperlinkItem As Hyperlink
>     Dim Files_Found As String
>     Dim varStatus As Variant
>     Dim SwitchScreenUpdate As Integer
> '    I didn't need this for my application
> '    Dim CalcFileSize As Long
>     '/==========Variables=============
>     strResultsTableName = "tbl_LoadHyperLinks" 'Table to store info in
>     strDefaultMatch = "*.PDF" 'Change to what you want as default extension
>     r = 1
>     i = 1
>     blnSubFolders = False
>     strMessage_Wait1 = "Please wait while search is in progress..."
> '   Access doesn't require formating like original Excel version does.
> '   strMessage_Wait2 = "Please wait while formatting is completed..."
>     '/==========Variables=============
>     strFileNameFilter = InputBox("Ex:  *.* with find all files" & vbCr & _
>         "     blank will find all Office files" & vbCr & _
>         "     *.xls will find all Excel files" & vbCr & _
>         "     G*.doc will find all Word files beginning with G" & vbCr & _
>         "     Test.txt will find only the files named TEST.TXT" & vbCr, _
>         "Enter file name to match:", Default:=strDefaultMatch)
> 
>     If Len(strFileNameFilter) = 0 Then
>         strFileBoxDesc = "All MSOffice files"
>       Else
>         strFileBoxDesc = strFileNameFilter
>     End If
> 
>     msg = "Look for: " & strFileBoxDesc & vbCrLf & _
>         " - Select location of files to be listed or press Cancel."
>     Directory = GetDirectory(msg)
>     If Directory = "" Then Exit Function
>     If Right(Directory, 1) <> "\" Then Directory = Directory & "\"
> 
>     varSubFolders = _
>         MsgBox("Search Sub-Folders of " & Directory & " ?", _
>         vbInformation + vbYesNoCancel, "Search Sub-Folders?")
>     If varSubFolders = vbYes Then blnSubFolders = True
>     If varSubFolders = vbNo Then blnSubFolders = False
>     If varSubFolders = vbCancel Then Exit Function
>     DoCmd.Hourglass True
> '   Access specific I used a form so user doesn't think computer frozen
>     DoCmd.OpenForm "frm_PleaseWait", acNormal, "", "", , acNormal
>     Forms!frm_PleaseWait.Repaint
>     r = r + 1
>     On Error Resume Next
> 
>     varStatus = SysCmd(acSysCmdSetStatus, strMessage_Wait1)
>     Set MyDB = CurrentDb
>     Set MyTable = MyDB.OpenRecordset("tbl_LoadHyperLinks")
>     With Application.FileSearch
>         .NewSearch
>         .LookIn = Directory
>         '.FileName = "*.*"
>         .FileName = strFileNameFilter
>         '.SearchSubFolders = False
>         .SearchSubFolders = blnSubFolders
>         .Execute
>         For i = 1 To .FoundFiles.Count
>             strFileName = ""
>             strPath = ""
>             For Y = Len(.FoundFiles(i)) To 1 Step -1
>                 If Mid(.FoundFiles(i), Y, 1) = "\" Then
>                     Exit For
>                 End If
>                 strFileName = Mid(.FoundFiles(i), Y, 1) & strFileName
>             Next Y
>             strPath = Left(.FoundFiles(i), Len(.FoundFiles(i)) - 
> Len(strFileName))
>             strExtension = ""
>             For Y = Len(strFileName) To 1 Step -1
>                 If Mid(strFileName, Y, 1) = "." Then
>                     If Len(strFileName) - Y <> 0 Then
>                         strExtension = Right(strFileName, Len(strFileName) - 
> Y)
>                         strFileName = Left(strFileName, Y - 1)
>                         Exit For
>                     End If
>                 End If
>             Next Y
>             MyTable.AddNew
>             MyTable("FileHyperLink") = strPath & strFileName & "#" & 
> (.FoundFiles(i)) & "##" & "Open Manual " & strFileName _
>             & " file size is " & FileLen(.FoundFiles(i))
>             MyTable("FilePath") = strPath
>             MyTable("FileFilename") = strFileName
>             MyTable("FileExtension") = strExtension
>             MyTable("FileSize") = FileLen(.FoundFiles(i))
>             MyTable("FileDateTime") = FileDateTime(.FoundFiles(i))
>             MyTable.Update
>             r = r + 1
>             SwitchScreenUpdate = SwitchScreenUpdate + 1
>             If SwitchScreenUpdate = 20 Then
>                 Files_Found = "Writing Record " & r - 1
>                 Forms!frm_PleaseWait.File_Found.Visible = True
>                 Forms!frm_PleaseWait.File_Found.Caption = Files_Found
>                 Forms!frm_PleaseWait.Repaint
>                 SwitchScreenUpdate = 0
>             End If
>         Next i
>     End With
>     MyTable.Close
>     Set MyTable = Nothing
>     Forms!frm_PleaseWait.File_Found.Visible = False
>     DoCmd.Close acForm, "frm_PleaseWait"
>     DoCmd.Hourglass False
> 
>     If Len(strFileNameFilter) = 0 Then
>         strFileNameFilter = "All MSOffice products"
>     End If
>     If blnSubFolders Then
>         Directory = "(including Subfolders) - " & Directory
>     End If
> Exit_ListFiles:
> ' Find access equivalent for below.
> '    Application.StatusBar = False
>     Exit Function
> Err_ListFiles:
>     MsgBox "Error: " & Err & " - " & Err.Description
>     Resume Exit_ListFiles
> End Function
> '=======================================
> Function GetDirectory(Optional msg) As String
>     Dim bInfo As BROWSEINFO
>     Dim path As String
>     Dim r As Long, x As Long, pos As Integer
> ' Root folder = Desktop
>     bInfo.pidlRoot = 0&
> ' Title in the dialog
>     If IsMissing(msg) Then
>         bInfo.lpszTitle = "Select a folder."
>     Else
>         bInfo.lpszTitle = msg
>   End If
> ' Type of directory to return
>     bInfo.ulFlags = &H1
> ' Display the dialog
>     x = SHBrowseForFolder(bInfo)
> ' Parse the result
>     path = Space$(512)
>     r = SHGetPathFromIDList(ByVal x, ByVal path)
>     If r Then
>         pos = InStr(path, Chr$(0))
>         GetDirectory = Left(path, pos - 1)
>     Else
>         GetDirectory = ""
>   End If
> End Function
> '===============End Code=================
> Function FileSearcher()
> On Error Resume Next
>     Dim n As Long
>     Dim SwitchScreenUpdate As Integer
>     Dim Files_Found As String
>     With Application.FileSearch
>         .LookIn = "\Folderpathfilename\"
>         .FileName = "*.*"
>         .SearchSubFolders = True
> '       Need to update, not needed for current application but will fix 
> later
> '            If .Execute(SortBy:=msoSortByFilename, 
> SortOrder:=msoSortOrderAscending, _
> '            alwaysAccurate:=True) > 0 Then
> '                For n = 1 To .FoundFiles.Count
> '                    Worksheets("Sheet1").Cells(n, "A").Value = 
> ..FoundFiles(n)
> '                     varStatus = SysCmd(acSysCmdInitMeter, strStatus, 
> ..FoundFiles(n))
> '                Next
> '            End If
>     End With
> End Function
> 
> 
> "efandango" <efandango@discussions.microsoft.com> wrote in message 
> news:AADDB95D-1A74-4F98-A415-AFC8FA30EE2D@microsoft.com...
> > There is Master Field number [Run_no] for each main record that links to 
> > the
> > images sub table. But how do I get an update query to link a folder path 
> > to a
> > field name? Also, I can't see how the field name works, it just has a
> > paperclip icon for each record field in the sub table?
> >
> >
> >
> >
> > "pietlinden@hotmail.com" wrote:
> >
> >> On Jul 8, 2:42 am, efandango <efanda...@discussions.microsoft.com>
> >> wrote:
> >> > I have a very long list of Images in a single folder that I want to 
> >> > attach to
> >> > seperate fields in a table/form.
> >> >
> >> > Each record contains two images, which are named like this:
> >> >
> >> > W:\Foldername\Micromap Run 001 A.bmp     =(1st record)
> >> > W:\Foldername\Micromap Run 001 B.bmp     =(1st record)
> >> > W:\Foldername\Micromap Run 002 A.bmp     =(2nd record)
> >> > W:\Foldername\Micromap Run 002 B.bmp     =(2nd record)
> >> > W:\Foldername\Micromap Run 003 A.bmp     =(3rd record)
> >> > W:\Foldername\Micromap Run 003 B.bmp     =(3rd record)
> >> >
> >> > and so on...
> >> >
> >> > Image A goes to field A
> >> > Image B goes to field B
> >> >
> >> > Is there a way of doing this automatically?
> >> >
> >> > The total list of records is 320 (x2 = 640 images)
> >>
> >> If there's some kind of rule/algorithm you can use to determine which
> >> image goes with which record, then it's easy.  Just use an update
> >> query.
> >>
> >> 
> 
> 
> 
0
Utf
7/8/2007 11:00:00 PM
it will still work, just use the file created to make your attachments.  If 
you have a problem let me know and I'll get to the nuts and bolts.  Pete
"efandango" <efandango@discussions.microsoft.com> wrote in message 
news:A5B9BC99-52B4-46D6-B37D-EA4C825B90DD@microsoft.com...
> Pete,
>
> Thanks for that, I havne't tried it yet, but after reading your response, 
> I
> realised that perhaps I should have mentioned that I am not using 
> hyperlinks,
> but the attachments feature in MS Access 2007. Are you familiar with it?.
>
> "Pete" wrote:
>
>> This module will do what you need, I assume you only need the file
>> location/hyperlink.  This was not my code to start, I modified it so you
>> must keep the author info in the code and revisions out of respect for 
>> those
>> that share.  Pete
>>
>> '/==========Code starts here================
>> Option Compare Database
>> Option Explicit
>> 'created using John Walkenbach's "Microsoft Excel 2000 Power
>> '  Programming with VBA" example as a basic starting point
>> '====================================
>> '32-bit API declarations
>> Declare Function SHGetPathFromIDList Lib "shell32.dll" _
>>   Alias "SHGetPathFromIDListA" (ByVal pidl As Long, _
>>   ByVal pszPath As String) As Long
>>
>> Declare Function SHBrowseForFolder Lib "shell32.dll" _
>>   Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) _
>>   As Long
>> '=====================================
>> Public Type BROWSEINFO
>>   hOwner As Long
>>   pidlRoot As Long
>>   pszDisplayName As String
>>   lpszTitle As String
>>   ulFlags As Long
>>   lpfn As Long
>>   lParam As Long
>>   iImage As Long
>> End Type
>> '=====================================
>>
>> Public Function ListFilesToTable()
>> On Error Resume Next
>>     'History:
>>     ' 07/15/2000 added hyperlink
>>     ' 07/17/2000 added filename filter
>>     ' 07/20/2000 added # files found info & criteria info
>>     ' 07/27/2000 added extension as separate column
>>     ' 08/03/2000 changed # files found to 'count' formula
>>     ' 10/23/2000 add status bar 'Wait' message
>>     ' 04/09/2007 Borrowed code from John Walkenbach's to
>>     ' manage USAF vehicle repair manuals in MS Access Pete Duffy
>>     Dim MyDB As Database
>>     Dim MyTable As Recordset
>>     Dim blnSubFolders As Boolean
>>     Dim dblLastRow As Double
>>     Dim i As Integer, r As Integer, x As Integer
>>     Dim Y As Integer ', iWorksheets As Integer Not needed for Access
>>     Dim msg As String, Directory As String, strPath As String
>>     Dim strResultsTableName As String, strFileName As String
>>     Dim strFileNameFilter As String, strDefaultMatch As String
>>     Dim strExtension As String, strFileBoxDesc As String
>>     Dim strMessage_Wait1 As String, strMessage_Wait2 As String
>>     Dim varSubFolders As Variant
>>     Dim strHyperlinkItem As Hyperlink
>>     Dim Files_Found As String
>>     Dim varStatus As Variant
>>     Dim SwitchScreenUpdate As Integer
>> '    I didn't need this for my application
>> '    Dim CalcFileSize As Long
>>     '/==========Variables=============
>>     strResultsTableName = "tbl_LoadHyperLinks" 'Table to store info in
>>     strDefaultMatch = "*.PDF" 'Change to what you want as default 
>> extension
>>     r = 1
>>     i = 1
>>     blnSubFolders = False
>>     strMessage_Wait1 = "Please wait while search is in progress..."
>> '   Access doesn't require formating like original Excel version does.
>> '   strMessage_Wait2 = "Please wait while formatting is completed..."
>>     '/==========Variables=============
>>     strFileNameFilter = InputBox("Ex:  *.* with find all files" & vbCr & 
>> _
>>         "     blank will find all Office files" & vbCr & _
>>         "     *.xls will find all Excel files" & vbCr & _
>>         "     G*.doc will find all Word files beginning with G" & vbCr & 
>> _
>>         "     Test.txt will find only the files named TEST.TXT" & vbCr, _
>>         "Enter file name to match:", Default:=strDefaultMatch)
>>
>>     If Len(strFileNameFilter) = 0 Then
>>         strFileBoxDesc = "All MSOffice files"
>>       Else
>>         strFileBoxDesc = strFileNameFilter
>>     End If
>>
>>     msg = "Look for: " & strFileBoxDesc & vbCrLf & _
>>         " - Select location of files to be listed or press Cancel."
>>     Directory = GetDirectory(msg)
>>     If Directory = "" Then Exit Function
>>     If Right(Directory, 1) <> "\" Then Directory = Directory & "\"
>>
>>     varSubFolders = _
>>         MsgBox("Search Sub-Folders of " & Directory & " ?", _
>>         vbInformation + vbYesNoCancel, "Search Sub-Folders?")
>>     If varSubFolders = vbYes Then blnSubFolders = True
>>     If varSubFolders = vbNo Then blnSubFolders = False
>>     If varSubFolders = vbCancel Then Exit Function
>>     DoCmd.Hourglass True
>> '   Access specific I used a form so user doesn't think computer frozen
>>     DoCmd.OpenForm "frm_PleaseWait", acNormal, "", "", , acNormal
>>     Forms!frm_PleaseWait.Repaint
>>     r = r + 1
>>     On Error Resume Next
>>
>>     varStatus = SysCmd(acSysCmdSetStatus, strMessage_Wait1)
>>     Set MyDB = CurrentDb
>>     Set MyTable = MyDB.OpenRecordset("tbl_LoadHyperLinks")
>>     With Application.FileSearch
>>         .NewSearch
>>         .LookIn = Directory
>>         '.FileName = "*.*"
>>         .FileName = strFileNameFilter
>>         '.SearchSubFolders = False
>>         .SearchSubFolders = blnSubFolders
>>         .Execute
>>         For i = 1 To .FoundFiles.Count
>>             strFileName = ""
>>             strPath = ""
>>             For Y = Len(.FoundFiles(i)) To 1 Step -1
>>                 If Mid(.FoundFiles(i), Y, 1) = "\" Then
>>                     Exit For
>>                 End If
>>                 strFileName = Mid(.FoundFiles(i), Y, 1) & strFileName
>>             Next Y
>>             strPath = Left(.FoundFiles(i), Len(.FoundFiles(i)) -
>> Len(strFileName))
>>             strExtension = ""
>>             For Y = Len(strFileName) To 1 Step -1
>>                 If Mid(strFileName, Y, 1) = "." Then
>>                     If Len(strFileName) - Y <> 0 Then
>>                         strExtension = Right(strFileName, 
>> Len(strFileName) -
>> Y)
>>                         strFileName = Left(strFileName, Y - 1)
>>                         Exit For
>>                     End If
>>                 End If
>>             Next Y
>>             MyTable.AddNew
>>             MyTable("FileHyperLink") = strPath & strFileName & "#" &
>> (.FoundFiles(i)) & "##" & "Open Manual " & strFileName _
>>             & " file size is " & FileLen(.FoundFiles(i))
>>             MyTable("FilePath") = strPath
>>             MyTable("FileFilename") = strFileName
>>             MyTable("FileExtension") = strExtension
>>             MyTable("FileSize") = FileLen(.FoundFiles(i))
>>             MyTable("FileDateTime") = FileDateTime(.FoundFiles(i))
>>             MyTable.Update
>>             r = r + 1
>>             SwitchScreenUpdate = SwitchScreenUpdate + 1
>>             If SwitchScreenUpdate = 20 Then
>>                 Files_Found = "Writing Record " & r - 1
>>                 Forms!frm_PleaseWait.File_Found.Visible = True
>>                 Forms!frm_PleaseWait.File_Found.Caption = Files_Found
>>                 Forms!frm_PleaseWait.Repaint
>>                 SwitchScreenUpdate = 0
>>             End If
>>         Next i
>>     End With
>>     MyTable.Close
>>     Set MyTable = Nothing
>>     Forms!frm_PleaseWait.File_Found.Visible = False
>>     DoCmd.Close acForm, "frm_PleaseWait"
>>     DoCmd.Hourglass False
>>
>>     If Len(strFileNameFilter) = 0 Then
>>         strFileNameFilter = "All MSOffice products"
>>     End If
>>     If blnSubFolders Then
>>         Directory = "(including Subfolders) - " & Directory
>>     End If
>> Exit_ListFiles:
>> ' Find access equivalent for below.
>> '    Application.StatusBar = False
>>     Exit Function
>> Err_ListFiles:
>>     MsgBox "Error: " & Err & " - " & Err.Description
>>     Resume Exit_ListFiles
>> End Function
>> '=======================================
>> Function GetDirectory(Optional msg) As String
>>     Dim bInfo As BROWSEINFO
>>     Dim path As String
>>     Dim r As Long, x As Long, pos As Integer
>> ' Root folder = Desktop
>>     bInfo.pidlRoot = 0&
>> ' Title in the dialog
>>     If IsMissing(msg) Then
>>         bInfo.lpszTitle = "Select a folder."
>>     Else
>>         bInfo.lpszTitle = msg
>>   End If
>> ' Type of directory to return
>>     bInfo.ulFlags = &H1
>> ' Display the dialog
>>     x = SHBrowseForFolder(bInfo)
>> ' Parse the result
>>     path = Space$(512)
>>     r = SHGetPathFromIDList(ByVal x, ByVal path)
>>     If r Then
>>         pos = InStr(path, Chr$(0))
>>         GetDirectory = Left(path, pos - 1)
>>     Else
>>         GetDirectory = ""
>>   End If
>> End Function
>> '===============End Code=================
>> Function FileSearcher()
>> On Error Resume Next
>>     Dim n As Long
>>     Dim SwitchScreenUpdate As Integer
>>     Dim Files_Found As String
>>     With Application.FileSearch
>>         .LookIn = "\Folderpathfilename\"
>>         .FileName = "*.*"
>>         .SearchSubFolders = True
>> '       Need to update, not needed for current application but will fix
>> later
>> '            If .Execute(SortBy:=msoSortByFilename,
>> SortOrder:=msoSortOrderAscending, _
>> '            alwaysAccurate:=True) > 0 Then
>> '                For n = 1 To .FoundFiles.Count
>> '                    Worksheets("Sheet1").Cells(n, "A").Value =
>> ..FoundFiles(n)
>> '                     varStatus = SysCmd(acSysCmdInitMeter, strStatus,
>> ..FoundFiles(n))
>> '                Next
>> '            End If
>>     End With
>> End Function
>>
>>
>> "efandango" <efandango@discussions.microsoft.com> wrote in message
>> news:AADDB95D-1A74-4F98-A415-AFC8FA30EE2D@microsoft.com...
>> > There is Master Field number [Run_no] for each main record that links 
>> > to
>> > the
>> > images sub table. But how do I get an update query to link a folder 
>> > path
>> > to a
>> > field name? Also, I can't see how the field name works, it just has a
>> > paperclip icon for each record field in the sub table?
>> >
>> >
>> >
>> >
>> > "pietlinden@hotmail.com" wrote:
>> >
>> >> On Jul 8, 2:42 am, efandango <efanda...@discussions.microsoft.com>
>> >> wrote:
>> >> > I have a very long list of Images in a single folder that I want to
>> >> > attach to
>> >> > seperate fields in a table/form.
>> >> >
>> >> > Each record contains two images, which are named like this:
>> >> >
>> >> > W:\Foldername\Micromap Run 001 A.bmp     =(1st record)
>> >> > W:\Foldername\Micromap Run 001 B.bmp     =(1st record)
>> >> > W:\Foldername\Micromap Run 002 A.bmp     =(2nd record)
>> >> > W:\Foldername\Micromap Run 002 B.bmp     =(2nd record)
>> >> > W:\Foldername\Micromap Run 003 A.bmp     =(3rd record)
>> >> > W:\Foldername\Micromap Run 003 B.bmp     =(3rd record)
>> >> >
>> >> > and so on...
>> >> >
>> >> > Image A goes to field A
>> >> > Image B goes to field B
>> >> >
>> >> > Is there a way of doing this automatically?
>> >> >
>> >> > The total list of records is 320 (x2 = 640 images)
>> >>
>> >> If there's some kind of rule/algorithm you can use to determine which
>> >> image goes with which record, then it's easy.  Just use an update
>> >> query.
>> >>
>> >>
>>
>>
>> 


0
Pete
7/9/2007 12:14:57 AM
Yes I am, I'll have to look at it as this will bring all the file names and 
directories in for you into a table.  I'll look and see how to finish it in 
2007 access.
"efandango" <efandango@discussions.microsoft.com> wrote in message 
news:A5B9BC99-52B4-46D6-B37D-EA4C825B90DD@microsoft.com...
> Pete,
>
> Thanks for that, I havne't tried it yet, but after reading your response, 
> I
> realised that perhaps I should have mentioned that I am not using 
> hyperlinks,
> but the attachments feature in MS Access 2007. Are you familiar with it?.
>
> "Pete" wrote:
>
>> This module will do what you need, I assume you only need the file
>> location/hyperlink.  This was not my code to start, I modified it so you
>> must keep the author info in the code and revisions out of respect for 
>> those
>> that share.  Pete
>>
>> '/==========Code starts here================
>> Option Compare Database
>> Option Explicit
>> 'created using John Walkenbach's "Microsoft Excel 2000 Power
>> '  Programming with VBA" example as a basic starting point
>> '====================================
>> '32-bit API declarations
>> Declare Function SHGetPathFromIDList Lib "shell32.dll" _
>>   Alias "SHGetPathFromIDListA" (ByVal pidl As Long, _
>>   ByVal pszPath As String) As Long
>>
>> Declare Function SHBrowseForFolder Lib "shell32.dll" _
>>   Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) _
>>   As Long
>> '=====================================
>> Public Type BROWSEINFO
>>   hOwner As Long
>>   pidlRoot As Long
>>   pszDisplayName As String
>>   lpszTitle As String
>>   ulFlags As Long
>>   lpfn As Long
>>   lParam As Long
>>   iImage As Long
>> End Type
>> '=====================================
>>
>> Public Function ListFilesToTable()
>> On Error Resume Next
>>     'History:
>>     ' 07/15/2000 added hyperlink
>>     ' 07/17/2000 added filename filter
>>     ' 07/20/2000 added # files found info & criteria info
>>     ' 07/27/2000 added extension as separate column
>>     ' 08/03/2000 changed # files found to 'count' formula
>>     ' 10/23/2000 add status bar 'Wait' message
>>     ' 04/09/2007 Borrowed code from John Walkenbach's to
>>     ' manage USAF vehicle repair manuals in MS Access Pete Duffy
>>     Dim MyDB As Database
>>     Dim MyTable As Recordset
>>     Dim blnSubFolders As Boolean
>>     Dim dblLastRow As Double
>>     Dim i As Integer, r As Integer, x As Integer
>>     Dim Y As Integer ', iWorksheets As Integer Not needed for Access
>>     Dim msg As String, Directory As String, strPath As String
>>     Dim strResultsTableName As String, strFileName As String
>>     Dim strFileNameFilter As String, strDefaultMatch As String
>>     Dim strExtension As String, strFileBoxDesc As String
>>     Dim strMessage_Wait1 As String, strMessage_Wait2 As String
>>     Dim varSubFolders As Variant
>>     Dim strHyperlinkItem As Hyperlink
>>     Dim Files_Found As String
>>     Dim varStatus As Variant
>>     Dim SwitchScreenUpdate As Integer
>> '    I didn't need this for my application
>> '    Dim CalcFileSize As Long
>>     '/==========Variables=============
>>     strResultsTableName = "tbl_LoadHyperLinks" 'Table to store info in
>>     strDefaultMatch = "*.PDF" 'Change to what you want as default 
>> extension
>>     r = 1
>>     i = 1
>>     blnSubFolders = False
>>     strMessage_Wait1 = "Please wait while search is in progress..."
>> '   Access doesn't require formating like original Excel version does.
>> '   strMessage_Wait2 = "Please wait while formatting is completed..."
>>     '/==========Variables=============
>>     strFileNameFilter = InputBox("Ex:  *.* with find all files" & vbCr & 
>> _
>>         "     blank will find all Office files" & vbCr & _
>>         "     *.xls will find all Excel files" & vbCr & _
>>         "     G*.doc will find all Word files beginning with G" & vbCr & 
>> _
>>         "     Test.txt will find only the files named TEST.TXT" & vbCr, _
>>         "Enter file name to match:", Default:=strDefaultMatch)
>>
>>     If Len(strFileNameFilter) = 0 Then
>>         strFileBoxDesc = "All MSOffice files"
>>       Else
>>         strFileBoxDesc = strFileNameFilter
>>     End If
>>
>>     msg = "Look for: " & strFileBoxDesc & vbCrLf & _
>>         " - Select location of files to be listed or press Cancel."
>>     Directory = GetDirectory(msg)
>>     If Directory = "" Then Exit Function
>>     If Right(Directory, 1) <> "\" Then Directory = Directory & "\"
>>
>>     varSubFolders = _
>>         MsgBox("Search Sub-Folders of " & Directory & " ?", _
>>         vbInformation + vbYesNoCancel, "Search Sub-Folders?")
>>     If varSubFolders = vbYes Then blnSubFolders = True
>>     If varSubFolders = vbNo Then blnSubFolders = False
>>     If varSubFolders = vbCancel Then Exit Function
>>     DoCmd.Hourglass True
>> '   Access specific I used a form so user doesn't think computer frozen
>>     DoCmd.OpenForm "frm_PleaseWait", acNormal, "", "", , acNormal
>>     Forms!frm_PleaseWait.Repaint
>>     r = r + 1
>>     On Error Resume Next
>>
>>     varStatus = SysCmd(acSysCmdSetStatus, strMessage_Wait1)
>>     Set MyDB = CurrentDb
>>     Set MyTable = MyDB.OpenRecordset("tbl_LoadHyperLinks")
>>     With Application.FileSearch
>>         .NewSearch
>>         .LookIn = Directory
>>         '.FileName = "*.*"
>>         .FileName = strFileNameFilter
>>         '.SearchSubFolders = False
>>         .SearchSubFolders = blnSubFolders
>>         .Execute
>>         For i = 1 To .FoundFiles.Count
>>             strFileName = ""
>>             strPath = ""
>>             For Y = Len(.FoundFiles(i)) To 1 Step -1
>>                 If Mid(.FoundFiles(i), Y, 1) = "\" Then
>>                     Exit For
>>                 End If
>>                 strFileName = Mid(.FoundFiles(i), Y, 1) & strFileName
>>             Next Y
>>             strPath = Left(.FoundFiles(i), Len(.FoundFiles(i)) -
>> Len(strFileName))
>>             strExtension = ""
>>             For Y = Len(strFileName) To 1 Step -1
>>                 If Mid(strFileName, Y, 1) = "." Then
>>                     If Len(strFileName) - Y <> 0 Then
>>                         strExtension = Right(strFileName, 
>> Len(strFileName) -
>> Y)
>>                         strFileName = Left(strFileName, Y - 1)
>>                         Exit For
>>                     End If
>>                 End If
>>             Next Y
>>             MyTable.AddNew
>>             MyTable("FileHyperLink") = strPath & strFileName & "#" &
>> (.FoundFiles(i)) & "##" & "Open Manual " & strFileName _
>>             & " file size is " & FileLen(.FoundFiles(i))
>>             MyTable("FilePath") = strPath
>>             MyTable("FileFilename") = strFileName
>>             MyTable("FileExtension") = strExtension
>>             MyTable("FileSize") = FileLen(.FoundFiles(i))
>>             MyTable("FileDateTime") = FileDateTime(.FoundFiles(i))
>>             MyTable.Update
>>             r = r + 1
>>             SwitchScreenUpdate = SwitchScreenUpdate + 1
>>             If SwitchScreenUpdate = 20 Then
>>                 Files_Found = "Writing Record " & r - 1
>>                 Forms!frm_PleaseWait.File_Found.Visible = True
>>                 Forms!frm_PleaseWait.File_Found.Caption = Files_Found
>>                 Forms!frm_PleaseWait.Repaint
>>                 SwitchScreenUpdate = 0
>>             End If
>>         Next i
>>     End With
>>     MyTable.Close
>>     Set MyTable = Nothing
>>     Forms!frm_PleaseWait.File_Found.Visible = False
>>     DoCmd.Close acForm, "frm_PleaseWait"
>>     DoCmd.Hourglass False
>>
>>     If Len(strFileNameFilter) = 0 Then
>>         strFileNameFilter = "All MSOffice products"
>>     End If
>>     If blnSubFolders Then
>>         Directory = "(including Subfolders) - " & Directory
>>     End If
>> Exit_ListFiles:
>> ' Find access equivalent for below.
>> '    Application.StatusBar = False
>>     Exit Function
>> Err_ListFiles:
>>     MsgBox "Error: " & Err & " - " & Err.Description
>>     Resume Exit_ListFiles
>> End Function
>> '=======================================
>> Function GetDirectory(Optional msg) As String
>>     Dim bInfo As BROWSEINFO
>>     Dim path As String
>>     Dim r As Long, x As Long, pos As Integer
>> ' Root folder = Desktop
>>     bInfo.pidlRoot = 0&
>> ' Title in the dialog
>>     If IsMissing(msg) Then
>>         bInfo.lpszTitle = "Select a folder."
>>     Else
>>         bInfo.lpszTitle = msg
>>   End If
>> ' Type of directory to return
>>     bInfo.ulFlags = &H1
>> ' Display the dialog
>>     x = SHBrowseForFolder(bInfo)
>> ' Parse the result
>>     path = Space$(512)
>>     r = SHGetPathFromIDList(ByVal x, ByVal path)
>>     If r Then
>>         pos = InStr(path, Chr$(0))
>>         GetDirectory = Left(path, pos - 1)
>>     Else
>>         GetDirectory = ""
>>   End If
>> End Function
>> '===============End Code=================
>> Function FileSearcher()
>> On Error Resume Next
>>     Dim n As Long
>>     Dim SwitchScreenUpdate As Integer
>>     Dim Files_Found As String
>>     With Application.FileSearch
>>         .LookIn = "\Folderpathfilename\"
>>         .FileName = "*.*"
>>         .SearchSubFolders = True
>> '       Need to update, not needed for current application but will fix
>> later
>> '            If .Execute(SortBy:=msoSortByFilename,
>> SortOrder:=msoSortOrderAscending, _
>> '            alwaysAccurate:=True) > 0 Then
>> '                For n = 1 To .FoundFiles.Count
>> '                    Worksheets("Sheet1").Cells(n, "A").Value =
>> ..FoundFiles(n)
>> '                     varStatus = SysCmd(acSysCmdInitMeter, strStatus,
>> ..FoundFiles(n))
>> '                Next
>> '            End If
>>     End With
>> End Function
>>
>>
>> "efandango" <efandango@discussions.microsoft.com> wrote in message
>> news:AADDB95D-1A74-4F98-A415-AFC8FA30EE2D@microsoft.com...
>> > There is Master Field number [Run_no] for each main record that links 
>> > to
>> > the
>> > images sub table. But how do I get an update query to link a folder 
>> > path
>> > to a
>> > field name? Also, I can't see how the field name works, it just has a
>> > paperclip icon for each record field in the sub table?
>> >
>> >
>> >
>> >
>> > "pietlinden@hotmail.com" wrote:
>> >
>> >> On Jul 8, 2:42 am, efandango <efanda...@discussions.microsoft.com>
>> >> wrote:
>> >> > I have a very long list of Images in a single folder that I want to
>> >> > attach to
>> >> > seperate fields in a table/form.
>> >> >
>> >> > Each record contains two images, which are named like this:
>> >> >
>> >> > W:\Foldername\Micromap Run 001 A.bmp     =(1st record)
>> >> > W:\Foldername\Micromap Run 001 B.bmp     =(1st record)
>> >> > W:\Foldername\Micromap Run 002 A.bmp     =(2nd record)
>> >> > W:\Foldername\Micromap Run 002 B.bmp     =(2nd record)
>> >> > W:\Foldername\Micromap Run 003 A.bmp     =(3rd record)
>> >> > W:\Foldername\Micromap Run 003 B.bmp     =(3rd record)
>> >> >
>> >> > and so on...
>> >> >
>> >> > Image A goes to field A
>> >> > Image B goes to field B
>> >> >
>> >> > Is there a way of doing this automatically?
>> >> >
>> >> > The total list of records is 320 (x2 = 640 images)
>> >>
>> >> If there's some kind of rule/algorithm you can use to determine which
>> >> image goes with which record, then it's easy.  Just use an update
>> >> query.
>> >>
>> >>
>>
>>
>> 


0
Pete
7/9/2007 9:41:48 PM
Might look at Allen Brown site, http://allenbrowne.com/Access2007.html#Good
He states that file growth could be a problem.  As he is known for making 
Access do things that cannot be done in Access I tend to watch his site.  I 
am a hobbiest at Access and if it says MVP at the bottom and he hasn't been 
flamed by a MVP it is probally really good advice.  By bringing in the file, 
directory, hyperlink you have light text and can usually do everything you 
want with VBA to open, edit, view, and place on forms or reports what ever 
it is.  Just a thought but if you want to do it with attachments which I 
understand office 2007 apps support throughout I'll look at it and get back 
to you.  Of course at any time one of those MVP's may jump in instead of 
this backyard Access user...yep, my primary job is Mechanic/IT manager. 
Pete

"Pete" <pduffy211@cox.netNoJunk> wrote in message 
news:kYxki.3961$nb2.336@newsfe14.lga...
> Yes I am, I'll have to look at it as this will bring all the file names 
> and directories in for you into a table.  I'll look and see how to finish 
> it in 2007 access.
> "efandango" <efandango@discussions.microsoft.com> wrote in message 
> news:A5B9BC99-52B4-46D6-B37D-EA4C825B90DD@microsoft.com...
>> Pete,
>>
>> Thanks for that, I havne't tried it yet, but after reading your response, 
>> I
>> realised that perhaps I should have mentioned that I am not using 
>> hyperlinks,
>> but the attachments feature in MS Access 2007. Are you familiar with it?.
>>
>> "Pete" wrote:
>>
>>> This module will do what you need, I assume you only need the file
>>> location/hyperlink.  This was not my code to start, I modified it so you
>>> must keep the author info in the code and revisions out of respect for 
>>> those
>>> that share.  Pete
>>>
>>> '/==========Code starts here================
>>> Option Compare Database
>>> Option Explicit
>>> 'created using John Walkenbach's "Microsoft Excel 2000 Power
>>> '  Programming with VBA" example as a basic starting point
>>> '====================================
>>> '32-bit API declarations
>>> Declare Function SHGetPathFromIDList Lib "shell32.dll" _
>>>   Alias "SHGetPathFromIDListA" (ByVal pidl As Long, _
>>>   ByVal pszPath As String) As Long
>>>
>>> Declare Function SHBrowseForFolder Lib "shell32.dll" _
>>>   Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) _
>>>   As Long
>>> '=====================================
>>> Public Type BROWSEINFO
>>>   hOwner As Long
>>>   pidlRoot As Long
>>>   pszDisplayName As String
>>>   lpszTitle As String
>>>   ulFlags As Long
>>>   lpfn As Long
>>>   lParam As Long
>>>   iImage As Long
>>> End Type
>>> '=====================================
>>>
>>> Public Function ListFilesToTable()
>>> On Error Resume Next
>>>     'History:
>>>     ' 07/15/2000 added hyperlink
>>>     ' 07/17/2000 added filename filter
>>>     ' 07/20/2000 added # files found info & criteria info
>>>     ' 07/27/2000 added extension as separate column
>>>     ' 08/03/2000 changed # files found to 'count' formula
>>>     ' 10/23/2000 add status bar 'Wait' message
>>>     ' 04/09/2007 Borrowed code from John Walkenbach's to
>>>     ' manage USAF vehicle repair manuals in MS Access Pete Duffy
>>>     Dim MyDB As Database
>>>     Dim MyTable As Recordset
>>>     Dim blnSubFolders As Boolean
>>>     Dim dblLastRow As Double
>>>     Dim i As Integer, r As Integer, x As Integer
>>>     Dim Y As Integer ', iWorksheets As Integer Not needed for Access
>>>     Dim msg As String, Directory As String, strPath As String
>>>     Dim strResultsTableName As String, strFileName As String
>>>     Dim strFileNameFilter As String, strDefaultMatch As String
>>>     Dim strExtension As String, strFileBoxDesc As String
>>>     Dim strMessage_Wait1 As String, strMessage_Wait2 As String
>>>     Dim varSubFolders As Variant
>>>     Dim strHyperlinkItem As Hyperlink
>>>     Dim Files_Found As String
>>>     Dim varStatus As Variant
>>>     Dim SwitchScreenUpdate As Integer
>>> '    I didn't need this for my application
>>> '    Dim CalcFileSize As Long
>>>     '/==========Variables=============
>>>     strResultsTableName = "tbl_LoadHyperLinks" 'Table to store info in
>>>     strDefaultMatch = "*.PDF" 'Change to what you want as default 
>>> extension
>>>     r = 1
>>>     i = 1
>>>     blnSubFolders = False
>>>     strMessage_Wait1 = "Please wait while search is in progress..."
>>> '   Access doesn't require formating like original Excel version does.
>>> '   strMessage_Wait2 = "Please wait while formatting is completed..."
>>>     '/==========Variables=============
>>>     strFileNameFilter = InputBox("Ex:  *.* with find all files" & vbCr & 
>>> _
>>>         "     blank will find all Office files" & vbCr & _
>>>         "     *.xls will find all Excel files" & vbCr & _
>>>         "     G*.doc will find all Word files beginning with G" & vbCr & 
>>> _
>>>         "     Test.txt will find only the files named TEST.TXT" & vbCr, 
>>> _
>>>         "Enter file name to match:", Default:=strDefaultMatch)
>>>
>>>     If Len(strFileNameFilter) = 0 Then
>>>         strFileBoxDesc = "All MSOffice files"
>>>       Else
>>>         strFileBoxDesc = strFileNameFilter
>>>     End If
>>>
>>>     msg = "Look for: " & strFileBoxDesc & vbCrLf & _
>>>         " - Select location of files to be listed or press Cancel."
>>>     Directory = GetDirectory(msg)
>>>     If Directory = "" Then Exit Function
>>>     If Right(Directory, 1) <> "\" Then Directory = Directory & "\"
>>>
>>>     varSubFolders = _
>>>         MsgBox("Search Sub-Folders of " & Directory & " ?", _
>>>         vbInformation + vbYesNoCancel, "Search Sub-Folders?")
>>>     If varSubFolders = vbYes Then blnSubFolders = True
>>>     If varSubFolders = vbNo Then blnSubFolders = False
>>>     If varSubFolders = vbCancel Then Exit Function
>>>     DoCmd.Hourglass True
>>> '   Access specific I used a form so user doesn't think computer frozen
>>>     DoCmd.OpenForm "frm_PleaseWait", acNormal, "", "", , acNormal
>>>     Forms!frm_PleaseWait.Repaint
>>>     r = r + 1
>>>     On Error Resume Next
>>>
>>>     varStatus = SysCmd(acSysCmdSetStatus, strMessage_Wait1)
>>>     Set MyDB = CurrentDb
>>>     Set MyTable = MyDB.OpenRecordset("tbl_LoadHyperLinks")
>>>     With Application.FileSearch
>>>         .NewSearch
>>>         .LookIn = Directory
>>>         '.FileName = "*.*"
>>>         .FileName = strFileNameFilter
>>>         '.SearchSubFolders = False
>>>         .SearchSubFolders = blnSubFolders
>>>         .Execute
>>>         For i = 1 To .FoundFiles.Count
>>>             strFileName = ""
>>>             strPath = ""
>>>             For Y = Len(.FoundFiles(i)) To 1 Step -1
>>>                 If Mid(.FoundFiles(i), Y, 1) = "\" Then
>>>                     Exit For
>>>                 End If
>>>                 strFileName = Mid(.FoundFiles(i), Y, 1) & strFileName
>>>             Next Y
>>>             strPath = Left(.FoundFiles(i), Len(.FoundFiles(i)) -
>>> Len(strFileName))
>>>             strExtension = ""
>>>             For Y = Len(strFileName) To 1 Step -1
>>>                 If Mid(strFileName, Y, 1) = "." Then
>>>                     If Len(strFileName) - Y <> 0 Then
>>>                         strExtension = Right(strFileName, 
>>> Len(strFileName) -
>>> Y)
>>>                         strFileName = Left(strFileName, Y - 1)
>>>                         Exit For
>>>                     End If
>>>                 End If
>>>             Next Y
>>>             MyTable.AddNew
>>>             MyTable("FileHyperLink") = strPath & strFileName & "#" &
>>> (.FoundFiles(i)) & "##" & "Open Manual " & strFileName _
>>>             & " file size is " & FileLen(.FoundFiles(i))
>>>             MyTable("FilePath") = strPath
>>>             MyTable("FileFilename") = strFileName
>>>             MyTable("FileExtension") = strExtension
>>>             MyTable("FileSize") = FileLen(.FoundFiles(i))
>>>             MyTable("FileDateTime") = FileDateTime(.FoundFiles(i))
>>>             MyTable.Update
>>>             r = r + 1
>>>             SwitchScreenUpdate = SwitchScreenUpdate + 1
>>>             If SwitchScreenUpdate = 20 Then
>>>                 Files_Found = "Writing Record " & r - 1
>>>                 Forms!frm_PleaseWait.File_Found.Visible = True
>>>                 Forms!frm_PleaseWait.File_Found.Caption = Files_Found
>>>                 Forms!frm_PleaseWait.Repaint
>>>                 SwitchScreenUpdate = 0
>>>             End If
>>>         Next i
>>>     End With
>>>     MyTable.Close
>>>     Set MyTable = Nothing
>>>     Forms!frm_PleaseWait.File_Found.Visible = False
>>>     DoCmd.Close acForm, "frm_PleaseWait"
>>>     DoCmd.Hourglass False
>>>
>>>     If Len(strFileNameFilter) = 0 Then
>>>         strFileNameFilter = "All MSOffice products"
>>>     End If
>>>     If blnSubFolders Then
>>>         Directory = "(including Subfolders) - " & Directory
>>>     End If
>>> Exit_ListFiles:
>>> ' Find access equivalent for below.
>>> '    Application.StatusBar = False
>>>     Exit Function
>>> Err_ListFiles:
>>>     MsgBox "Error: " & Err & " - " & Err.Description
>>>     Resume Exit_ListFiles
>>> End Function
>>> '=======================================
>>> Function GetDirectory(Optional msg) As String
>>>     Dim bInfo As BROWSEINFO
>>>     Dim path As String
>>>     Dim r As Long, x As Long, pos As Integer
>>> ' Root folder = Desktop
>>>     bInfo.pidlRoot = 0&
>>> ' Title in the dialog
>>>     If IsMissing(msg) Then
>>>         bInfo.lpszTitle = "Select a folder."
>>>     Else
>>>         bInfo.lpszTitle = msg
>>>   End If
>>> ' Type of directory to return
>>>     bInfo.ulFlags = &H1
>>> ' Display the dialog
>>>     x = SHBrowseForFolder(bInfo)
>>> ' Parse the result
>>>     path = Space$(512)
>>>     r = SHGetPathFromIDList(ByVal x, ByVal path)
>>>     If r Then
>>>         pos = InStr(path, Chr$(0))
>>>         GetDirectory = Left(path, pos - 1)
>>>     Else
>>>         GetDirectory = ""
>>>   End If
>>> End Function
>>> '===============End Code=================
>>> Function FileSearcher()
>>> On Error Resume Next
>>>     Dim n As Long
>>>     Dim SwitchScreenUpdate As Integer
>>>     Dim Files_Found As String
>>>     With Application.FileSearch
>>>         .LookIn = "\Folderpathfilename\"
>>>         .FileName = "*.*"
>>>         .SearchSubFolders = True
>>> '       Need to update, not needed for current application but will fix
>>> later
>>> '            If .Execute(SortBy:=msoSortByFilename,
>>> SortOrder:=msoSortOrderAscending, _
>>> '            alwaysAccurate:=True) > 0 Then
>>> '                For n = 1 To .FoundFiles.Count
>>> '                    Worksheets("Sheet1").Cells(n, "A").Value =
>>> ..FoundFiles(n)
>>> '                     varStatus = SysCmd(acSysCmdInitMeter, strStatus,
>>> ..FoundFiles(n))
>>> '                Next
>>> '            End If
>>>     End With
>>> End Function
>>>
>>>
>>> "efandango" <efandango@discussions.microsoft.com> wrote in message
>>> news:AADDB95D-1A74-4F98-A415-AFC8FA30EE2D@microsoft.com...
>>> > There is Master Field number [Run_no] for each main record that links 
>>> > to
>>> > the
>>> > images sub table. But how do I get an update query to link a folder 
>>> > path
>>> > to a
>>> > field name? Also, I can't see how the field name works, it just has a
>>> > paperclip icon for each record field in the sub table?
>>> >
>>> >
>>> >
>>> >
>>> > "pietlinden@hotmail.com" wrote:
>>> >
>>> >> On Jul 8, 2:42 am, efandango <efanda...@discussions.microsoft.com>
>>> >> wrote:
>>> >> > I have a very long list of Images in a single folder that I want to
>>> >> > attach to
>>> >> > seperate fields in a table/form.
>>> >> >
>>> >> > Each record contains two images, which are named like this:
>>> >> >
>>> >> > W:\Foldername\Micromap Run 001 A.bmp     =(1st record)
>>> >> > W:\Foldername\Micromap Run 001 B.bmp     =(1st record)
>>> >> > W:\Foldername\Micromap Run 002 A.bmp     =(2nd record)
>>> >> > W:\Foldername\Micromap Run 002 B.bmp     =(2nd record)
>>> >> > W:\Foldername\Micromap Run 003 A.bmp     =(3rd record)
>>> >> > W:\Foldername\Micromap Run 003 B.bmp     =(3rd record)
>>> >> >
>>> >> > and so on...
>>> >> >
>>> >> > Image A goes to field A
>>> >> > Image B goes to field B
>>> >> >
>>> >> > Is there a way of doing this automatically?
>>> >> >
>>> >> > The total list of records is 320 (x2 = 640 images)
>>> >>
>>> >> If there's some kind of rule/algorithm you can use to determine which
>>> >> image goes with which record, then it's easy.  Just use an update
>>> >> query.
>>> >>
>>> >>
>>>
>>>
>>>
>
> 


0
Pete
7/9/2007 10:23:32 PM
Here is the datafile layout,  You don't need file remarks or anything 
afterwards.

Table: tbl_LoadHyperLinks 
Page: 1
  Columns

            Name 
Type                               Size

            FileHyperLink 
Anchor                                               -

            FilePath 
Text                                               255

            FileFilename 
Text                                               255

            FileExtension 
Text                                                  4

            FileSize 
Text                                                10

            FileDateTime 
Text                                                50

            FileRemarks 
Text                                               255

            UserLogon 
Text                                                50

            DateModified 
Date/Time                                           8

            TimeModified 
Date/Time                                           8

            MachineName 
Text                                                16

"Pete" <pduffy211@cox.netNoJunk> wrote in message 
news:kYxki.3961$nb2.336@newsfe14.lga...
> Yes I am, I'll have to look at it as this will bring all the file names 
> and directories in for you into a table.  I'll look and see how to finish 
> it in 2007 access.
> "efandango" <efandango@discussions.microsoft.com> wrote in message 
> news:A5B9BC99-52B4-46D6-B37D-EA4C825B90DD@microsoft.com...
>> Pete,
>>
>> Thanks for that, I havne't tried it yet, but after reading your response, 
>> I
>> realised that perhaps I should have mentioned that I am not using 
>> hyperlinks,
>> but the attachments feature in MS Access 2007. Are you familiar with it?.
>>
>> "Pete" wrote:
>>
>>> This module will do what you need, I assume you only need the file
>>> location/hyperlink.  This was not my code to start, I modified it so you
>>> must keep the author info in the code and revisions out of respect for 
>>> those
>>> that share.  Pete
>>>
>>> '/==========Code starts here================
>>> Option Compare Database
>>> Option Explicit
>>> 'created using John Walkenbach's "Microsoft Excel 2000 Power
>>> '  Programming with VBA" example as a basic starting point
>>> '====================================
>>> '32-bit API declarations
>>> Declare Function SHGetPathFromIDList Lib "shell32.dll" _
>>>   Alias "SHGetPathFromIDListA" (ByVal pidl As Long, _
>>>   ByVal pszPath As String) As Long
>>>
>>> Declare Function SHBrowseForFolder Lib "shell32.dll" _
>>>   Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) _
>>>   As Long
>>> '=====================================
>>> Public Type BROWSEINFO
>>>   hOwner As Long
>>>   pidlRoot As Long
>>>   pszDisplayName As String
>>>   lpszTitle As String
>>>   ulFlags As Long
>>>   lpfn As Long
>>>   lParam As Long
>>>   iImage As Long
>>> End Type
>>> '=====================================
>>>
>>> Public Function ListFilesToTable()
>>> On Error Resume Next
>>>     'History:
>>>     ' 07/15/2000 added hyperlink
>>>     ' 07/17/2000 added filename filter
>>>     ' 07/20/2000 added # files found info & criteria info
>>>     ' 07/27/2000 added extension as separate column
>>>     ' 08/03/2000 changed # files found to 'count' formula
>>>     ' 10/23/2000 add status bar 'Wait' message
>>>     ' 04/09/2007 Borrowed code from John Walkenbach's to
>>>     ' manage USAF vehicle repair manuals in MS Access Pete Duffy
>>>     Dim MyDB As Database
>>>     Dim MyTable As Recordset
>>>     Dim blnSubFolders As Boolean
>>>     Dim dblLastRow As Double
>>>     Dim i As Integer, r As Integer, x As Integer
>>>     Dim Y As Integer ', iWorksheets As Integer Not needed for Access
>>>     Dim msg As String, Directory As String, strPath As String
>>>     Dim strResultsTableName As String, strFileName As String
>>>     Dim strFileNameFilter As String, strDefaultMatch As String
>>>     Dim strExtension As String, strFileBoxDesc As String
>>>     Dim strMessage_Wait1 As String, strMessage_Wait2 As String
>>>     Dim varSubFolders As Variant
>>>     Dim strHyperlinkItem As Hyperlink
>>>     Dim Files_Found As String
>>>     Dim varStatus As Variant
>>>     Dim SwitchScreenUpdate As Integer
>>> '    I didn't need this for my application
>>> '    Dim CalcFileSize As Long
>>>     '/==========Variables=============
>>>     strResultsTableName = "tbl_LoadHyperLinks" 'Table to store info in
>>>     strDefaultMatch = "*.PDF" 'Change to what you want as default 
>>> extension
>>>     r = 1
>>>     i = 1
>>>     blnSubFolders = False
>>>     strMessage_Wait1 = "Please wait while search is in progress..."
>>> '   Access doesn't require formating like original Excel version does.
>>> '   strMessage_Wait2 = "Please wait while formatting is completed..."
>>>     '/==========Variables=============
>>>     strFileNameFilter = InputBox("Ex:  *.* with find all files" & vbCr & 
>>> _
>>>         "     blank will find all Office files" & vbCr & _
>>>         "     *.xls will find all Excel files" & vbCr & _
>>>         "     G*.doc will find all Word files beginning with G" & vbCr & 
>>> _
>>>         "     Test.txt will find only the files named TEST.TXT" & vbCr, 
>>> _
>>>         "Enter file name to match:", Default:=strDefaultMatch)
>>>
>>>     If Len(strFileNameFilter) = 0 Then
>>>         strFileBoxDesc = "All MSOffice files"
>>>       Else
>>>         strFileBoxDesc = strFileNameFilter
>>>     End If
>>>
>>>     msg = "Look for: " & strFileBoxDesc & vbCrLf & _
>>>         " - Select location of files to be listed or press Cancel."
>>>     Directory = GetDirectory(msg)
>>>     If Directory = "" Then Exit Function
>>>     If Right(Directory, 1) <> "\" Then Directory = Directory & "\"
>>>
>>>     varSubFolders = _
>>>         MsgBox("Search Sub-Folders of " & Directory & " ?", _
>>>         vbInformation + vbYesNoCancel, "Search Sub-Folders?")
>>>     If varSubFolders = vbYes Then blnSubFolders = True
>>>     If varSubFolders = vbNo Then blnSubFolders = False
>>>     If varSubFolders = vbCancel Then Exit Function
>>>     DoCmd.Hourglass True
>>> '   Access specific I used a form so user doesn't think computer frozen
>>>     DoCmd.OpenForm "frm_PleaseWait", acNormal, "", "", , acNormal
>>>     Forms!frm_PleaseWait.Repaint
>>>     r = r + 1
>>>     On Error Resume Next
>>>
>>>     varStatus = SysCmd(acSysCmdSetStatus, strMessage_Wait1)
>>>     Set MyDB = CurrentDb
>>>     Set MyTable = MyDB.OpenRecordset("tbl_LoadHyperLinks")
>>>     With Application.FileSearch
>>>         .NewSearch
>>>         .LookIn = Directory
>>>         '.FileName = "*.*"
>>>         .FileName = strFileNameFilter
>>>         '.SearchSubFolders = False
>>>         .SearchSubFolders = blnSubFolders
>>>         .Execute
>>>         For i = 1 To .FoundFiles.Count
>>>             strFileName = ""
>>>             strPath = ""
>>>             For Y = Len(.FoundFiles(i)) To 1 Step -1
>>>                 If Mid(.FoundFiles(i), Y, 1) = "\" Then
>>>                     Exit For
>>>                 End If
>>>                 strFileName = Mid(.FoundFiles(i), Y, 1) & strFileName
>>>             Next Y
>>>             strPath = Left(.FoundFiles(i), Len(.FoundFiles(i)) -
>>> Len(strFileName))
>>>             strExtension = ""
>>>             For Y = Len(strFileName) To 1 Step -1
>>>                 If Mid(strFileName, Y, 1) = "." Then
>>>                     If Len(strFileName) - Y <> 0 Then
>>>                         strExtension = Right(strFileName, 
>>> Len(strFileName) -
>>> Y)
>>>                         strFileName = Left(strFileName, Y - 1)
>>>                         Exit For
>>>                     End If
>>>                 End If
>>>             Next Y
>>>             MyTable.AddNew
>>>             MyTable("FileHyperLink") = strPath & strFileName & "#" &
>>> (.FoundFiles(i)) & "##" & "Open Manual " & strFileName _
>>>             & " file size is " & FileLen(.FoundFiles(i))
>>>             MyTable("FilePath") = strPath
>>>             MyTable("FileFilename") = strFileName
>>>             MyTable("FileExtension") = strExtension
>>>             MyTable("FileSize") = FileLen(.FoundFiles(i))
>>>             MyTable("FileDateTime") = FileDateTime(.FoundFiles(i))
>>>             MyTable.Update
>>>             r = r + 1
>>>             SwitchScreenUpdate = SwitchScreenUpdate + 1
>>>             If SwitchScreenUpdate = 20 Then
>>>                 Files_Found = "Writing Record " & r - 1
>>>                 Forms!frm_PleaseWait.File_Found.Visible = True
>>>                 Forms!frm_PleaseWait.File_Found.Caption = Files_Found
>>>                 Forms!frm_PleaseWait.Repaint
>>>                 SwitchScreenUpdate = 0
>>>             End If
>>>         Next i
>>>     End With
>>>     MyTable.Close
>>>     Set MyTable = Nothing
>>>     Forms!frm_PleaseWait.File_Found.Visible = False
>>>     DoCmd.Close acForm, "frm_PleaseWait"
>>>     DoCmd.Hourglass False
>>>
>>>     If Len(strFileNameFilter) = 0 Then
>>>         strFileNameFilter = "All MSOffice products"
>>>     End If
>>>     If blnSubFolders Then
>>>         Directory = "(including Subfolders) - " & Directory
>>>     End If
>>> Exit_ListFiles:
>>> ' Find access equivalent for below.
>>> '    Application.StatusBar = False
>>>     Exit Function
>>> Err_ListFiles:
>>>     MsgBox "Error: " & Err & " - " & Err.Description
>>>     Resume Exit_ListFiles
>>> End Function
>>> '=======================================
>>> Function GetDirectory(Optional msg) As String
>>>     Dim bInfo As BROWSEINFO
>>>     Dim path As String
>>>     Dim r As Long, x As Long, pos As Integer
>>> ' Root folder = Desktop
>>>     bInfo.pidlRoot = 0&
>>> ' Title in the dialog
>>>     If IsMissing(msg) Then
>>>         bInfo.lpszTitle = "Select a folder."
>>>     Else
>>>         bInfo.lpszTitle = msg
>>>   End If
>>> ' Type of directory to return
>>>     bInfo.ulFlags = &H1
>>> ' Display the dialog
>>>     x = SHBrowseForFolder(bInfo)
>>> ' Parse the result
>>>     path = Space$(512)
>>>     r = SHGetPathFromIDList(ByVal x, ByVal path)
>>>     If r Then
>>>         pos = InStr(path, Chr$(0))
>>>         GetDirectory = Left(path, pos - 1)
>>>     Else
>>>         GetDirectory = ""
>>>   End If
>>> End Function
>>> '===============End Code=================
>>> Function FileSearcher()
>>> On Error Resume Next
>>>     Dim n As Long
>>>     Dim SwitchScreenUpdate As Integer
>>>     Dim Files_Found As String
>>>     With Application.FileSearch
>>>         .LookIn = "\Folderpathfilename\"
>>>         .FileName = "*.*"
>>>         .SearchSubFolders = True
>>> '       Need to update, not needed for current application but will fix
>>> later
>>> '            If .Execute(SortBy:=msoSortByFilename,
>>> SortOrder:=msoSortOrderAscending, _
>>> '            alwaysAccurate:=True) > 0 Then
>>> '                For n = 1 To .FoundFiles.Count
>>> '                    Worksheets("Sheet1").Cells(n, "A").Value =
>>> ..FoundFiles(n)
>>> '                     varStatus = SysCmd(acSysCmdInitMeter, strStatus,
>>> ..FoundFiles(n))
>>> '                Next
>>> '            End If
>>>     End With
>>> End Function
>>>
>>>
>>> "efandango" <efandango@discussions.microsoft.com> wrote in message
>>> news:AADDB95D-1A74-4F98-A415-AFC8FA30EE2D@microsoft.com...
>>> > There is Master Field number [Run_no] for each main record that links 
>>> > to
>>> > the
>>> > images sub table. But how do I get an update query to link a folder 
>>> > path
>>> > to a
>>> > field name? Also, I can't see how the field name works, it just has a
>>> > paperclip icon for each record field in the sub table?
>>> >
>>> >
>>> >
>>> >
>>> > "pietlinden@hotmail.com" wrote:
>>> >
>>> >> On Jul 8, 2:42 am, efandango <efanda...@discussions.microsoft.com>
>>> >> wrote:
>>> >> > I have a very long list of Images in a single folder that I want to
>>> >> > attach to
>>> >> > seperate fields in a table/form.
>>> >> >
>>> >> > Each record contains two images, which are named like this:
>>> >> >
>>> >> > W:\Foldername\Micromap Run 001 A.bmp     =(1st record)
>>> >> > W:\Foldername\Micromap Run 001 B.bmp     =(1st record)
>>> >> > W:\Foldername\Micromap Run 002 A.bmp     =(2nd record)
>>> >> > W:\Foldername\Micromap Run 002 B.bmp     =(2nd record)
>>> >> > W:\Foldername\Micromap Run 003 A.bmp     =(3rd record)
>>> >> > W:\Foldername\Micromap Run 003 B.bmp     =(3rd record)
>>> >> >
>>> >> > and so on...
>>> >> >
>>> >> > Image A goes to field A
>>> >> > Image B goes to field B
>>> >> >
>>> >> > Is there a way of doing this automatically?
>>> >> >
>>> >> > The total list of records is 320 (x2 = 640 images)
>>> >>
>>> >> If there's some kind of rule/algorithm you can use to determine which
>>> >> image goes with which record, then it's easy.  Just use an update
>>> >> query.
>>> >>
>>> >>
>>>
>>>
>>>
>
> 


0
Pete
7/9/2007 10:38:24 PM
Hi,
I went through the new attachment feature and will have to bow out at this 
time.  What I sent you will bring file info in and append it to a file but I 
have owned 2007 for about a month and I'm still trying to find things on the 
new menus.   Sorry, Pete
"Pete" <pduffy211@cox.netNoJunk> wrote in message 
news:pNyki.70503$tL1.41809@newsfe22.lga...
> Here is the datafile layout,  You don't need file remarks or anything 
> afterwards.
>
> Table: tbl_LoadHyperLinks Page: 1
>  Columns
>
>            Name Type                               Size
>
>            FileHyperLink 
>        -
>
>            FilePath Text                                               255
>
>            FileFilename Text 
> 255
>
>            FileExtension Text 
> 4
>
>            FileSize Text                                                10
>
>            FileDateTime Text 
> 50
>
>            FileRemarks Text 
> 255
>
>            UserLogon Text 
> 50
>
>            DateModified Date/Time 
> 8
>
>            TimeModified Date/Time 
> 8
>
>            MachineName Text 
> 16
>
> "Pete" <pduffy211@cox.netNoJunk> wrote in message 
> news:kYxki.3961$nb2.336@newsfe14.lga...
>> Yes I am, I'll have to look at it as this will bring all the file names 
>> and directories in for you into a table.  I'll look and see how to finish 
>> it in 2007 access.
>> "efandango" <efandango@discussions.microsoft.com> wrote in message 
>> news:A5B9BC99-52B4-46D6-B37D-EA4C825B90DD@microsoft.com...
>>> Pete,
>>>
>>> Thanks for that, I havne't tried it yet, but after reading your 
>>> response, I
>>> realised that perhaps I should have mentioned that I am not using 
>>> hyperlinks,
>>> but the attachments feature in MS Access 2007. Are you familiar with 
>>> it?.
>>>
>>> "Pete" wrote:
>>>
>>>> This module will do what you need, I assume you only need the file
>>>> location/hyperlink.  This was not my code to start, I modified it so 
>>>> you
>>>> must keep the author info in the code and revisions out of respect for 
>>>> those
>>>> that share.  Pete
>>>>
>>>> '/==========Code starts here================
>>>> Option Compare Database
>>>> Option Explicit
>>>> 'created using John Walkenbach's "Microsoft Excel 2000 Power
>>>> '  Programming with VBA" example as a basic starting point
>>>> '====================================
>>>> '32-bit API declarations
>>>> Declare Function SHGetPathFromIDList Lib "shell32.dll" _
>>>>   Alias "SHGetPathFromIDListA" (ByVal pidl As Long, _
>>>>   ByVal pszPath As String) As Long
>>>>
>>>> Declare Function SHBrowseForFolder Lib "shell32.dll" _
>>>>   Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) _
>>>>   As Long
>>>> '=====================================
>>>> Public Type BROWSEINFO
>>>>   hOwner As Long
>>>>   pidlRoot As Long
>>>>   pszDisplayName As String
>>>>   lpszTitle As String
>>>>   ulFlags As Long
>>>>   lpfn As Long
>>>>   lParam As Long
>>>>   iImage As Long
>>>> End Type
>>>> '=====================================
>>>>
>>>> Public Function ListFilesToTable()
>>>> On Error Resume Next
>>>>     'History:
>>>>     ' 07/15/2000 added hyperlink
>>>>     ' 07/17/2000 added filename filter
>>>>     ' 07/20/2000 added # files found info & criteria info
>>>>     ' 07/27/2000 added extension as separate column
>>>>     ' 08/03/2000 changed # files found to 'count' formula
>>>>     ' 10/23/2000 add status bar 'Wait' message
>>>>     ' 04/09/2007 Borrowed code from John Walkenbach's to
>>>>     ' manage USAF vehicle repair manuals in MS Access Pete Duffy
>>>>     Dim MyDB As Database
>>>>     Dim MyTable As Recordset
>>>>     Dim blnSubFolders As Boolean
>>>>     Dim dblLastRow As Double
>>>>     Dim i As Integer, r As Integer, x As Integer
>>>>     Dim Y As Integer ', iWorksheets As Integer Not needed for Access
>>>>     Dim msg As String, Directory As String, strPath As String
>>>>     Dim strResultsTableName As String, strFileName As String
>>>>     Dim strFileNameFilter As String, strDefaultMatch As String
>>>>     Dim strExtension As String, strFileBoxDesc As String
>>>>     Dim strMessage_Wait1 As String, strMessage_Wait2 As String
>>>>     Dim varSubFolders As Variant
>>>>     Dim strHyperlinkItem As Hyperlink
>>>>     Dim Files_Found As String
>>>>     Dim varStatus As Variant
>>>>     Dim SwitchScreenUpdate As Integer
>>>> '    I didn't need this for my application
>>>> '    Dim CalcFileSize As Long
>>>>     '/==========Variables=============
>>>>     strResultsTableName = "tbl_LoadHyperLinks" 'Table to store info in
>>>>     strDefaultMatch = "*.PDF" 'Change to what you want as default 
>>>> extension
>>>>     r = 1
>>>>     i = 1
>>>>     blnSubFolders = False
>>>>     strMessage_Wait1 = "Please wait while search is in progress..."
>>>> '   Access doesn't require formating like original Excel version does.
>>>> '   strMessage_Wait2 = "Please wait while formatting is completed..."
>>>>     '/==========Variables=============
>>>>     strFileNameFilter = InputBox("Ex:  *.* with find all files" & vbCr 
>>>> & _
>>>>         "     blank will find all Office files" & vbCr & _
>>>>         "     *.xls will find all Excel files" & vbCr & _
>>>>         "     G*.doc will find all Word files beginning with G" & vbCr 
>>>> & _
>>>>         "     Test.txt will find only the files named TEST.TXT" & vbCr, 
>>>> _
>>>>         "Enter file name to match:", Default:=strDefaultMatch)
>>>>
>>>>     If Len(strFileNameFilter) = 0 Then
>>>>         strFileBoxDesc = "All MSOffice files"
>>>>       Else
>>>>         strFileBoxDesc = strFileNameFilter
>>>>     End If
>>>>
>>>>     msg = "Look for: " & strFileBoxDesc & vbCrLf & _
>>>>         " - Select location of files to be listed or press Cancel."
>>>>     Directory = GetDirectory(msg)
>>>>     If Directory = "" Then Exit Function
>>>>     If Right(Directory, 1) <> "\" Then Directory = Directory & "\"
>>>>
>>>>     varSubFolders = _
>>>>         MsgBox("Search Sub-Folders of " & Directory & " ?", _
>>>>         vbInformation + vbYesNoCancel, "Search Sub-Folders?")
>>>>     If varSubFolders = vbYes Then blnSubFolders = True
>>>>     If varSubFolders = vbNo Then blnSubFolders = False
>>>>     If varSubFolders = vbCancel Then Exit Function
>>>>     DoCmd.Hourglass True
>>>> '   Access specific I used a form so user doesn't think computer frozen
>>>>     DoCmd.OpenForm "frm_PleaseWait", acNormal, "", "", , acNormal
>>>>     Forms!frm_PleaseWait.Repaint
>>>>     r = r + 1
>>>>     On Error Resume Next
>>>>
>>>>     varStatus = SysCmd(acSysCmdSetStatus, strMessage_Wait1)
>>>>     Set MyDB = CurrentDb
>>>>     Set MyTable = MyDB.OpenRecordset("tbl_LoadHyperLinks")
>>>>     With Application.FileSearch
>>>>         .NewSearch
>>>>         .LookIn = Directory
>>>>         '.FileName = "*.*"
>>>>         .FileName = strFileNameFilter
>>>>         '.SearchSubFolders = False
>>>>         .SearchSubFolders = blnSubFolders
>>>>         .Execute
>>>>         For i = 1 To .FoundFiles.Count
>>>>             strFileName = ""
>>>>             strPath = ""
>>>>             For Y = Len(.FoundFiles(i)) To 1 Step -1
>>>>                 If Mid(.FoundFiles(i), Y, 1) = "\" Then
>>>>                     Exit For
>>>>                 End If
>>>>                 strFileName = Mid(.FoundFiles(i), Y, 1) & strFileName
>>>>             Next Y
>>>>             strPath = Left(.FoundFiles(i), Len(.FoundFiles(i)) -
>>>> Len(strFileName))
>>>>             strExtension = ""
>>>>             For Y = Len(strFileName) To 1 Step -1
>>>>                 If Mid(strFileName, Y, 1) = "." Then
>>>>                     If Len(strFileName) - Y <> 0 Then
>>>>                         strExtension = Right(strFileName, 
>>>> Len(strFileName) -
>>>> Y)
>>>>                         strFileName = Left(strFileName, Y - 1)
>>>>                         Exit For
>>>>                     End If
>>>>                 End If
>>>>             Next Y
>>>>             MyTable.AddNew
>>>>             MyTable("FileHyperLink") = strPath & strFileName & "#" &
>>>> (.FoundFiles(i)) & "##" & "Open Manual " & strFileName _
>>>>             & " file size is " & FileLen(.FoundFiles(i))
>>>>             MyTable("FilePath") = strPath
>>>>             MyTable("FileFilename") = strFileName
>>>>             MyTable("FileExtension") = strExtension
>>>>             MyTable("FileSize") = FileLen(.FoundFiles(i))
>>>>             MyTable("FileDateTime") = FileDateTime(.FoundFiles(i))
>>>>             MyTable.Update
>>>>             r = r + 1
>>>>             SwitchScreenUpdate = SwitchScreenUpdate + 1
>>>>             If SwitchScreenUpdate = 20 Then
>>>>                 Files_Found = "Writing Record " & r - 1
>>>>                 Forms!frm_PleaseWait.File_Found.Visible = True
>>>>                 Forms!frm_PleaseWait.File_Found.Caption = Files_Found
>>>>                 Forms!frm_PleaseWait.Repaint
>>>>                 SwitchScreenUpdate = 0
>>>>             End If
>>>>         Next i
>>>>     End With
>>>>     MyTable.Close
>>>>     Set MyTable = Nothing
>>>>     Forms!frm_PleaseWait.File_Found.Visible = False
>>>>     DoCmd.Close acForm, "frm_PleaseWait"
>>>>     DoCmd.Hourglass False
>>>>
>>>>     If Len(strFileNameFilter) = 0 Then
>>>>         strFileNameFilter = "All MSOffice products"
>>>>     End If
>>>>     If blnSubFolders Then
>>>>         Directory = "(including Subfolders) - " & Directory
>>>>     End If
>>>> Exit_ListFiles:
>>>> ' Find access equivalent for below.
>>>> '    Application.StatusBar = False
>>>>     Exit Function
>>>> Err_ListFiles:
>>>>     MsgBox "Error: " & Err & " - " & Err.Description
>>>>     Resume Exit_ListFiles
>>>> End Function
>>>> '=======================================
>>>> Function GetDirectory(Optional msg) As String
>>>>     Dim bInfo As BROWSEINFO
>>>>     Dim path As String
>>>>     Dim r As Long, x As Long, pos As Integer
>>>> ' Root folder = Desktop
>>>>     bInfo.pidlRoot = 0&
>>>> ' Title in the dialog
>>>>     If IsMissing(msg) Then
>>>>         bInfo.lpszTitle = "Select a folder."
>>>>     Else
>>>>         bInfo.lpszTitle = msg
>>>>   End If
>>>> ' Type of directory to return
>>>>     bInfo.ulFlags = &H1
>>>> ' Display the dialog
>>>>     x = SHBrowseForFolder(bInfo)
>>>> ' Parse the result
>>>>     path = Space$(512)
>>>>     r = SHGetPathFromIDList(ByVal x, ByVal path)
>>>>     If r Then
>>>>         pos = InStr(path, Chr$(0))
>>>>         GetDirectory = Left(path, pos - 1)
>>>>     Else
>>>>         GetDirectory = ""
>>>>   End If
>>>> End Function
>>>> '===============End Code=================
>>>> Function FileSearcher()
>>>> On Error Resume Next
>>>>     Dim n As Long
>>>>     Dim SwitchScreenUpdate As Integer
>>>>     Dim Files_Found As String
>>>>     With Application.FileSearch
>>>>         .LookIn = "\Folderpathfilename\"
>>>>         .FileName = "*.*"
>>>>         .SearchSubFolders = True
>>>> '       Need to update, not needed for current application but will fix
>>>> later
>>>> '            If .Execute(SortBy:=msoSortByFilename,
>>>> SortOrder:=msoSortOrderAscending, _
>>>> '            alwaysAccurate:=True) > 0 Then
>>>> '                For n = 1 To .FoundFiles.Count
>>>> '                    Worksheets("Sheet1").Cells(n, "A").Value =
>>>> ..FoundFiles(n)
>>>> '                     varStatus = SysCmd(acSysCmdInitMeter, strStatus,
>>>> ..FoundFiles(n))
>>>> '                Next
>>>> '            End If
>>>>     End With
>>>> End Function
>>>>
>>>>
>>>> "efandango" <efandango@discussions.microsoft.com> wrote in message
>>>> news:AADDB95D-1A74-4F98-A415-AFC8FA30EE2D@microsoft.com...
>>>> > There is Master Field number [Run_no] for each main record that links 
>>>> > to
>>>> > the
>>>> > images sub table. But how do I get an update query to link a folder 
>>>> > path
>>>> > to a
>>>> > field name? Also, I can't see how the field name works, it just has a
>>>> > paperclip icon for each record field in the sub table?
>>>> >
>>>> >
>>>> >
>>>> >
>>>> > "pietlinden@hotmail.com" wrote:
>>>> >
>>>> >> On Jul 8, 2:42 am, efandango <efanda...@discussions.microsoft.com>
>>>> >> wrote:
>>>> >> > I have a very long list of Images in a single folder that I want 
>>>> >> > to
>>>> >> > attach to
>>>> >> > seperate fields in a table/form.
>>>> >> >
>>>> >> > Each record contains two images, which are named like this:
>>>> >> >
>>>> >> > W:\Foldername\Micromap Run 001 A.bmp     =(1st record)
>>>> >> > W:\Foldername\Micromap Run 001 B.bmp     =(1st record)
>>>> >> > W:\Foldername\Micromap Run 002 A.bmp     =(2nd record)
>>>> >> > W:\Foldername\Micromap Run 002 B.bmp     =(2nd record)
>>>> >> > W:\Foldername\Micromap Run 003 A.bmp     =(3rd record)
>>>> >> > W:\Foldername\Micromap Run 003 B.bmp     =(3rd record)
>>>> >> >
>>>> >> > and so on...
>>>> >> >
>>>> >> > Image A goes to field A
>>>> >> > Image B goes to field B
>>>> >> >
>>>> >> > Is there a way of doing this automatically?
>>>> >> >
>>>> >> > The total list of records is 320 (x2 = 640 images)
>>>> >>
>>>> >> If there's some kind of rule/algorithm you can use to determine 
>>>> >> which
>>>> >> image goes with which record, then it's easy.  Just use an update
>>>> >> query.
>>>> >>
>>>> >>
>>>>
>>>>
>>>>
>>
>>
>
> 


0
Pete
7/10/2007 11:28:28 PM
Can anyone else help on this problem. I can't understand why Microsoft didn't 
fully address the issue of bulk importation of images in a database in Access 
2007. 

Am I right in thinking that the 'new' Access 2007 multiple attachments 
feature is not specific enough for Image data handling? There has to be an 
alternitive to moving through each record and clicking 2 different image 
boxes, pointing toward at a directory and file for each image selection, over 
and over 600+ times!...



"efandango" wrote:

> I have a very long list of Images in a single folder that I want to attach to 
> seperate fields in a table/form.
> 
> Each record contains two images, which are named like this:
> 
> W:\Foldername\Micromap Run 001 A.bmp     =(1st record)
> W:\Foldername\Micromap Run 001 B.bmp     =(1st record)
> W:\Foldername\Micromap Run 002 A.bmp     =(2nd record)
> W:\Foldername\Micromap Run 002 B.bmp     =(2nd record)
> W:\Foldername\Micromap Run 003 A.bmp     =(3rd record)
> W:\Foldername\Micromap Run 003 B.bmp     =(3rd record)
> 
> and so on...
> 
> Image A goes to field A
> Image B goes to field B
> 
> 
> Is there a way of doing this automatically?
> 
> The total list of records is 320 (x2 = 640 images)
> 
> 
> 
> 
> 
0
Utf
7/25/2007 10:04:01 PM
Hi,
I have had time to read about attachments and might have what you need now. 
Read
http://msdn2.microsoft.com/en-us/library/Bb256357.aspx
These attachments are actually the complete file embeded in a hidden file 
within access.  Sooo, you must have files where access read them in.  You 
can attach them with a query as long as you can identify each file to the 
record.  You can use the file search and import them into a table.  Then see 
http://msdn2.microsoft.com/en-us/library/bb258184.aspx
How to: Work With Attachments In DAO and 
http://msdn2.microsoft.com/en-us/library/bb257442.aspx Field2.LoadFromFile 
Method and Field2.SaveToFile Method 
http://msdn2.microsoft.com/en-us/library/bb257443.aspx

These will show you what to use in the query for the parameters or how to do 
it in VBA.

"Pete" <pduffy211@cox.netNoJunk> wrote in message 
news:kCUki.46052$aP2.15686@newsfe16.lga...
> Hi,
> I went through the new attachment feature and will have to bow out at this 
> time.  What I sent you will bring file info in and append it to a file but 
> I have owned 2007 for about a month and I'm still trying to find things on 
> the new menus.   Sorry, Pete
> "Pete" <pduffy211@cox.netNoJunk> wrote in message 
> news:pNyki.70503$tL1.41809@newsfe22.lga...
>> Here is the datafile layout,  You don't need file remarks or anything 
>> afterwards.
>>
>> Table: tbl_LoadHyperLinks Page: 1
>>  Columns
>>
>>            Name Type                               Size
>>
>>            FileHyperLink -
>>
>>            FilePath Text 
>> 255
>>
>>            FileFilename Text 255
>>
>>            FileExtension Text 4
>>
>>            FileSize Text 
>> 10
>>
>>            FileDateTime Text 50
>>
>>            FileRemarks Text 255
>>
>>            UserLogon Text 50
>>
>>            DateModified Date/Time 8
>>
>>            TimeModified Date/Time 8
>>
>>            MachineName Text 16
>>
>> "Pete" <pduffy211@cox.netNoJunk> wrote in message 
>> news:kYxki.3961$nb2.336@newsfe14.lga...
>>> Yes I am, I'll have to look at it as this will bring all the file names 
>>> and directories in for you into a table.  I'll look and see how to 
>>> finish it in 2007 access.
>>> "efandango" <efandango@discussions.microsoft.com> wrote in message 
>>> news:A5B9BC99-52B4-46D6-B37D-EA4C825B90DD@microsoft.com...
>>>> Pete,
>>>>
>>>> Thanks for that, I havne't tried it yet, but after reading your 
>>>> response, I
>>>> realised that perhaps I should have mentioned that I am not using 
>>>> hyperlinks,
>>>> but the attachments feature in MS Access 2007. Are you familiar with 
>>>> it?.
>>>>
>>>> "Pete" wrote:
>>>>
>>>>> This module will do what you need, I assume you only need the file
>>>>> location/hyperlink.  This was not my code to start, I modified it so 
>>>>> you
>>>>> must keep the author info in the code and revisions out of respect for 
>>>>> those
>>>>> that share.  Pete
>>>>>
>>>>> '/==========Code starts here================
>>>>> Option Compare Database
>>>>> Option Explicit
>>>>> 'created using John Walkenbach's "Microsoft Excel 2000 Power
>>>>> '  Programming with VBA" example as a basic starting point
>>>>> '====================================
>>>>> '32-bit API declarations
>>>>> Declare Function SHGetPathFromIDList Lib "shell32.dll" _
>>>>>   Alias "SHGetPathFromIDListA" (ByVal pidl As Long, _
>>>>>   ByVal pszPath As String) As Long
>>>>>
>>>>> Declare Function SHBrowseForFolder Lib "shell32.dll" _
>>>>>   Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) _
>>>>>   As Long
>>>>> '=====================================
>>>>> Public Type BROWSEINFO
>>>>>   hOwner As Long
>>>>>   pidlRoot As Long
>>>>>   pszDisplayName As String
>>>>>   lpszTitle As String
>>>>>   ulFlags As Long
>>>>>   lpfn As Long
>>>>>   lParam As Long
>>>>>   iImage As Long
>>>>> End Type
>>>>> '=====================================
>>>>>
>>>>> Public Function ListFilesToTable()
>>>>> On Error Resume Next
>>>>>     'History:
>>>>>     ' 07/15/2000 added hyperlink
>>>>>     ' 07/17/2000 added filename filter
>>>>>     ' 07/20/2000 added # files found info & criteria info
>>>>>     ' 07/27/2000 added extension as separate column
>>>>>     ' 08/03/2000 changed # files found to 'count' formula
>>>>>     ' 10/23/2000 add status bar 'Wait' message
>>>>>     ' 04/09/2007 Borrowed code from John Walkenbach's to
>>>>>     ' manage USAF vehicle repair manuals in MS Access Pete Duffy
>>>>>     Dim MyDB As Database
>>>>>     Dim MyTable As Recordset
>>>>>     Dim blnSubFolders As Boolean
>>>>>     Dim dblLastRow As Double
>>>>>     Dim i As Integer, r As Integer, x As Integer
>>>>>     Dim Y As Integer ', iWorksheets As Integer Not needed for Access
>>>>>     Dim msg As String, Directory As String, strPath As String
>>>>>     Dim strResultsTableName As String, strFileName As String
>>>>>     Dim strFileNameFilter As String, strDefaultMatch As String
>>>>>     Dim strExtension As String, strFileBoxDesc As String
>>>>>     Dim strMessage_Wait1 As String, strMessage_Wait2 As String
>>>>>     Dim varSubFolders As Variant
>>>>>     Dim strHyperlinkItem As Hyperlink
>>>>>     Dim Files_Found As String
>>>>>     Dim varStatus As Variant
>>>>>     Dim SwitchScreenUpdate As Integer
>>>>> '    I didn't need this for my application
>>>>> '    Dim CalcFileSize As Long
>>>>>     '/==========Variables=============
>>>>>     strResultsTableName = "tbl_LoadHyperLinks" 'Table to store info in
>>>>>     strDefaultMatch = "*.PDF" 'Change to what you want as default 
>>>>> extension
>>>>>     r = 1
>>>>>     i = 1
>>>>>     blnSubFolders = False
>>>>>     strMessage_Wait1 = "Please wait while search is in progress..."
>>>>> '   Access doesn't require formating like original Excel version does.
>>>>> '   strMessage_Wait2 = "Please wait while formatting is completed..."
>>>>>     '/==========Variables=============
>>>>>     strFileNameFilter = InputBox("Ex:  *.* with find all files" & vbCr 
>>>>> & _
>>>>>         "     blank will find all Office files" & vbCr & _
>>>>>         "     *.xls will find all Excel files" & vbCr & _
>>>>>         "     G*.doc will find all Word files beginning with G" & vbCr 
>>>>> & _
>>>>>         "     Test.txt will find only the files named TEST.TXT" & 
>>>>> vbCr, _
>>>>>         "Enter file name to match:", Default:=strDefaultMatch)
>>>>>
>>>>>     If Len(strFileNameFilter) = 0 Then
>>>>>         strFileBoxDesc = "All MSOffice files"
>>>>>       Else
>>>>>         strFileBoxDesc = strFileNameFilter
>>>>>     End If
>>>>>
>>>>>     msg = "Look for: " & strFileBoxDesc & vbCrLf & _
>>>>>         " - Select location of files to be listed or press Cancel."
>>>>>     Directory = GetDirectory(msg)
>>>>>     If Directory = "" Then Exit Function
>>>>>     If Right(Directory, 1) <> "\" Then Directory = Directory & "\"
>>>>>
>>>>>     varSubFolders = _
>>>>>         MsgBox("Search Sub-Folders of " & Directory & " ?", _
>>>>>         vbInformation + vbYesNoCancel, "Search Sub-Folders?")
>>>>>     If varSubFolders = vbYes Then blnSubFolders = True
>>>>>     If varSubFolders = vbNo Then blnSubFolders = False
>>>>>     If varSubFolders = vbCancel Then Exit Function
>>>>>     DoCmd.Hourglass True
>>>>> '   Access specific I used a form so user doesn't think computer 
>>>>> frozen
>>>>>     DoCmd.OpenForm "frm_PleaseWait", acNormal, "", "", , acNormal
>>>>>     Forms!frm_PleaseWait.Repaint
>>>>>     r = r + 1
>>>>>     On Error Resume Next
>>>>>
>>>>>     varStatus = SysCmd(acSysCmdSetStatus, strMessage_Wait1)
>>>>>     Set MyDB = CurrentDb
>>>>>     Set MyTable = MyDB.OpenRecordset("tbl_LoadHyperLinks")
>>>>>     With Application.FileSearch
>>>>>         .NewSearch
>>>>>         .LookIn = Directory
>>>>>         '.FileName = "*.*"
>>>>>         .FileName = strFileNameFilter
>>>>>         '.SearchSubFolders = False
>>>>>         .SearchSubFolders = blnSubFolders
>>>>>         .Execute
>>>>>         For i = 1 To .FoundFiles.Count
>>>>>             strFileName = ""
>>>>>             strPath = ""
>>>>>             For Y = Len(.FoundFiles(i)) To 1 Step -1
>>>>>                 If Mid(.FoundFiles(i), Y, 1) = "\" Then
>>>>>                     Exit For
>>>>>                 End If
>>>>>                 strFileName = Mid(.FoundFiles(i), Y, 1) & strFileName
>>>>>             Next Y
>>>>>             strPath = Left(.FoundFiles(i), Len(.FoundFiles(i)) -
>>>>> Len(strFileName))
>>>>>             strExtension = ""
>>>>>             For Y = Len(strFileName) To 1 Step -1
>>>>>                 If Mid(strFileName, Y, 1) = "." Then
>>>>>                     If Len(strFileName) - Y <> 0 Then
>>>>>                         strExtension = Right(strFileName, 
>>>>> Len(strFileName) -
>>>>> Y)
>>>>>                         strFileName = Left(strFileName, Y - 1)
>>>>>                         Exit For
>>>>>                     End If
>>>>>                 End If
>>>>>             Next Y
>>>>>             MyTable.AddNew
>>>>>             MyTable("FileHyperLink") = strPath & strFileName & "#" &
>>>>> (.FoundFiles(i)) & "##" & "Open Manual " & strFileName _
>>>>>             & " file size is " & FileLen(.FoundFiles(i))
>>>>>             MyTable("FilePath") = strPath
>>>>>             MyTable("FileFilename") = strFileName
>>>>>             MyTable("FileExtension") = strExtension
>>>>>             MyTable("FileSize") = FileLen(.FoundFiles(i))
>>>>>             MyTable("FileDateTime") = FileDateTime(.FoundFiles(i))
>>>>>             MyTable.Update
>>>>>             r = r + 1
>>>>>             SwitchScreenUpdate = SwitchScreenUpdate + 1
>>>>>             If SwitchScreenUpdate = 20 Then
>>>>>                 Files_Found = "Writing Record " & r - 1
>>>>>                 Forms!frm_PleaseWait.File_Found.Visible = True
>>>>>                 Forms!frm_PleaseWait.File_Found.Caption = Files_Found
>>>>>                 Forms!frm_PleaseWait.Repaint
>>>>>                 SwitchScreenUpdate = 0
>>>>>             End If
>>>>>         Next i
>>>>>     End With
>>>>>     MyTable.Close
>>>>>     Set MyTable = Nothing
>>>>>     Forms!frm_PleaseWait.File_Found.Visible = False
>>>>>     DoCmd.Close acForm, "frm_PleaseWait"
>>>>>     DoCmd.Hourglass False
>>>>>
>>>>>     If Len(strFileNameFilter) = 0 Then
>>>>>         strFileNameFilter = "All MSOffice products"
>>>>>     End If
>>>>>     If blnSubFolders Then
>>>>>         Directory = "(including Subfolders) - " & Directory
>>>>>     End If
>>>>> Exit_ListFiles:
>>>>> ' Find access equivalent for below.
>>>>> '    Application.StatusBar = False
>>>>>     Exit Function
>>>>> Err_ListFiles:
>>>>>     MsgBox "Error: " & Err & " - " & Err.Description
>>>>>     Resume Exit_ListFiles
>>>>> End Function
>>>>> '=======================================
>>>>> Function GetDirectory(Optional msg) As String
>>>>>     Dim bInfo As BROWSEINFO
>>>>>     Dim path As String
>>>>>     Dim r As Long, x As Long, pos As Integer
>>>>> ' Root folder = Desktop
>>>>>     bInfo.pidlRoot = 0&
>>>>> ' Title in the dialog
>>>>>     If IsMissing(msg) Then
>>>>>         bInfo.lpszTitle = "Select a folder."
>>>>>     Else
>>>>>         bInfo.lpszTitle = msg
>>>>>   End If
>>>>> ' Type of directory to return
>>>>>     bInfo.ulFlags = &H1
>>>>> ' Display the dialog
>>>>>     x = SHBrowseForFolder(bInfo)
>>>>> ' Parse the result
>>>>>     path = Space$(512)
>>>>>     r = SHGetPathFromIDList(ByVal x, ByVal path)
>>>>>     If r Then
>>>>>         pos = InStr(path, Chr$(0))
>>>>>         GetDirectory = Left(path, pos - 1)
>>>>>     Else
>>>>>         GetDirectory = ""
>>>>>   End If
>>>>> End Function
>>>>> '===============End Code=================
>>>>> Function FileSearcher()
>>>>> On Error Resume Next
>>>>>     Dim n As Long
>>>>>     Dim SwitchScreenUpdate As Integer
>>>>>     Dim Files_Found As String
>>>>>     With Application.FileSearch
>>>>>         .LookIn = "\Folderpathfilename\"
>>>>>         .FileName = "*.*"
>>>>>         .SearchSubFolders = True
>>>>> '       Need to update, not needed for current application but will 
>>>>> fix
>>>>> later
>>>>> '            If .Execute(SortBy:=msoSortByFilename,
>>>>> SortOrder:=msoSortOrderAscending, _
>>>>> '            alwaysAccurate:=True) > 0 Then
>>>>> '                For n = 1 To .FoundFiles.Count
>>>>> '                    Worksheets("Sheet1").Cells(n, "A").Value =
>>>>> ..FoundFiles(n)
>>>>> '                     varStatus = SysCmd(acSysCmdInitMeter, strStatus,
>>>>> ..FoundFiles(n))
>>>>> '                Next
>>>>> '            End If
>>>>>     End With
>>>>> End Function
>>>>>
>>>>>
>>>>> "efandango" <efandango@discussions.microsoft.com> wrote in message
>>>>> news:AADDB95D-1A74-4F98-A415-AFC8FA30EE2D@microsoft.com...
>>>>> > There is Master Field number [Run_no] for each main record that 
>>>>> > links to
>>>>> > the
>>>>> > images sub table. But how do I get an update query to link a folder 
>>>>> > path
>>>>> > to a
>>>>> > field name? Also, I can't see how the field name works, it just has 
>>>>> > a
>>>>> > paperclip icon for each record field in the sub table?
>>>>> >
>>>>> >
>>>>> >
>>>>> >
>>>>> > "pietlinden@hotmail.com" wrote:
>>>>> >
>>>>> >> On Jul 8, 2:42 am, efandango <efanda...@discussions.microsoft.com>
>>>>> >> wrote:
>>>>> >> > I have a very long list of Images in a single folder that I want 
>>>>> >> > to
>>>>> >> > attach to
>>>>> >> > seperate fields in a table/form.
>>>>> >> >
>>>>> >> > Each record contains two images, which are named like this:
>>>>> >> >
>>>>> >> > W:\Foldername\Micromap Run 001 A.bmp     =(1st record)
>>>>> >> > W:\Foldername\Micromap Run 001 B.bmp     =(1st record)
>>>>> >> > W:\Foldername\Micromap Run 002 A.bmp     =(2nd record)
>>>>> >> > W:\Foldername\Micromap Run 002 B.bmp     =(2nd record)
>>>>> >> > W:\Foldername\Micromap Run 003 A.bmp     =(3rd record)
>>>>> >> > W:\Foldername\Micromap Run 003 B.bmp     =(3rd record)
>>>>> >> >
>>>>> >> > and so on...
>>>>> >> >
>>>>> >> > Image A goes to field A
>>>>> >> > Image B goes to field B
>>>>> >> >
>>>>> >> > Is there a way of doing this automatically?
>>>>> >> >
>>>>> >> > The total list of records is 320 (x2 = 640 images)
>>>>> >>
>>>>> >> If there's some kind of rule/algorithm you can use to determine 
>>>>> >> which
>>>>> >> image goes with which record, then it's easy.  Just use an update
>>>>> >> query.
>>>>> >>
>>>>> >>
>>>>>
>>>>>
>>>>>
>>>
>>>
>>
>>
>
> 


0
Pete
7/30/2007 1:04:19 AM
Reply:

Similar Artilces:

Bulk Processing, Bulk changes etc
I am looking for a way to bulk process large amounts of things at once, i see that there are inventory tasks with the wizard, but they are fairly basic - can i get extra ones somehow? For example, i want to refine my database and move a lot of items which have been incorrectly assigned to a supplier to the correct supplier. I can isolate these items as i know the first 5 digits of the EAN code denote this supplier, how can i then follow on to assign all these products to the correct supplier? Do i need to get up to speed with SQL?! Philip, For this case, it would be a SQL command. ...

outlook attachment
Can anyone please help? I tried to open an attachment, but it prompted me with a message "This object was created in Outlook. This application is not available to open this object. Make sure the application is properly installed and that it has not been deleted, moved, or renamed." Not your fault. Have the sender resend the message with an attachment in a format you can open. "Lynn" wrote: > Can anyone please help? I tried to open an attachment, but it prompted me > with a message "This object was created in Outlook. This application is not > av...

Announcements
I would like to be able to add attachments to the Announcements section. How can I do that? Thanks ...

Attachments
I send out an excel spreadsheet that has about 40 columns. Of the 40 want to only show 5 so I simply hide the other 35 columns. If I sen this to myself, when I open it I only see the five columns. However when others open it they see all 40. What am I doing that causes th entire spreadsheet to open up for others but keeps it the way I want i for me -- Message posted from http://www.ExcelForum.com Are the other users using xl97? I've seen posts that complain that xl97 won't keep the columnwidth between closing and opening. Some posters say that upgrading to SR2 helps. But others ...

Runtime Requirements for SOAP attachments
Hi, I have written an application in C++ that consumes webservices. The application works great on my pc, which I have visual studio installed. When I deploy the application to other user's pcs, it works on all the functions, except those that use soap attachments. I am using the ATLSOAP_BLOB datatype for passing binary data to a webservice. Are their any additional libraries or runtime components that I should install with the application. Thanks, Josh ...

Sending out bulk emails w/ new prog gets me blacklisted
Hi all... Been the admin for a K-12 private school for about 5 years now. We (still) run an exchange 5.5 email server and it has held its own. At one time, like 4 years ago, it had an open relay. Thats been closed and has never bothered us since. We use a database program by a company called Hunter Systems... the program is called SchoolMinder. It has a new feature in it that allows the accountant to email parents stuff like billing info, account info, even report card info... Only parents who "opt in" get the emails... First time we sent out an email with the program, we got sla...

Bulk Editing Excel Files
I frequently need to make a change to hundreds of excel files. The change is sometimes as simple as renaming a column name or inserting some text. Does anyone know of a tool that can help me accomplish this without having to manually open each excel file? Thanks in advance Dave Hi Dave Try http://www.rondebruin.nl/copy4.htm -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm <david.tawil@verizon.net> wrote in message news:ff35f336-02cf-4d48-be08-1d4b00eb6914@t54g2000hsg.googlegroups.com... >I frequently need to make a change to hundreds of excel files. The > change i...

Exchange and Bulk Email
We have lists of clients that we send bulk emails to. The problem we are having is that when we send the email out, with the distribution group in the BCC to hide the address's, 60% get returned because the recipients email server rejects it as spam. Probably because it is being sent to 100 address's within the company all at once. Is there a way in Exchange to setup it up so that sends each email individually spaced apart by like 2 seconds. Basically get it to act more like Majordomo? For $11G I would hope so, but this does not sound like it is the case. On Thu, 8 Dec 200...

Limit Recipients in Bulk Mail
I would like to know if i can make a setting that the maximum of recipients in a bulk mail can be set. I would like to have a limit of 500 recipients, but cant find the settings to make. You can limit it to 250: Go to options and set the maximum records per page to 250. Use CRM Mail Merge for Word to send the emails and merge to all records on current page. -- www.nauta-automatisering.nl "Deeske" wrote: > I would like to know if i can make a setting that the maximum of recipients > in a bulk mail can be set. > > I would like to have a limit of 500 recipients, b...

Want to put pdfs / attachments in folders in Entourage
I am use to using outlook on the pc and am switching to entourage. I have many folders in my personal .pst. I am trying to recreate these folders in entourage which is going 50% ok. I create the folder and push the emails that were in them in to the folder. This works fine. I also however have many items that aren't email in those folders, such as pdf's and things. Is there anyway to have entourage on the mac setup to accept pdf loose in those folders as well as emails that are archived? Tks in advance, Glen On 1/8/10 11:34 AM, in article 7c8826de-4efa-4525-9b2d-5c...

Mail merg attachments
How do I attach a document to an email when I am doing a mail merge? I have tried the obvious, attach file and the attachment appears to be stripped out. Any suggestions? Not supported in Outlook. You'd need third party software. http://www.slipstick.com/addins/mail.htm#massmail -- Russ Valentine [MVP-Outlook] "Heather" <anonymous@discussions.microsoft.com> wrote in message news:039801c3a3e8$a39a3b80$a501280a@phx.gbl... > How do I attach a document to an email when I am doing a > mail merge? I have tried the obvious, attach file and the > attachment appears to ...

delete in bulk
I have a mailbox with about 30,000 messages, all were generated by a program. I cant delete more than 4000 at a time according to exchange limitations. Is there anyway to delete all messages in a mailbox in one procedure? regards CR Delete the mail box and recreate it. They will be gone in a flash. "MSNews" wrote: > I have a mailbox with about 30,000 messages, all were generated by a > program. I cant delete more than 4000 at a time according to exchange > limitations. Is there anyway to delete all messages in a mailbox in one > procedure? > &...

Create Bulk Deletion Job in CRM 4
How can I create a bulk deletion job in the CRM 4 frontend without having the hassle of using the SDK. Thanks Roo; You cannot - SDK is the only way. recent post on the subject here: http://blogs.msdn.com/crm/archive/2008/11/13/leveraging-bulk-delete-jobs-to-manage-system-job-log-records.aspx Dave Ireland "Roo" <Roo@discussions.microsoft.com> wrote in message news:21C80B12-9A42-44B2-A996-5A63FA0E0AB8@microsoft.com... > How can I create a bulk deletion job in the CRM 4 frontend without having > the > hassle of using the SDK. > > Thanks Just for your in...

Insert an Excel attachment
How can insert an Excel attachment into Publisher? ...

JPG attachments
I recently upgraded office 97 to Office XP. Now I cannot open jpg attachments from email. Any ideas? ...

Bad attachments.
Hello, We are running exchange server 2003 on a windows 2k server Sp4. We have a customer using a Linux based email server, all attachments we receive from this customer are not usable and cannot be opened with their respective programs. For example, MS Word attachment are not readable. Is there something we can do to our sever to receive attachment correctly? or this is a problem on our customer's end? thank you in advance. If you receive attachments from all other domains then more than likely the problem is on the remote domain. You can use ARCHIVESINK or NETMON to get a better u...

Bulk changing of departments?
Hey guys I am looking for a way to make bulk changes to items in RMS HQ. I just started working for a company that has used RMS for quite a few years now and I have been asked to find out if there is a way to update department/categories on about 30k items that do not have any department or category. I have done a little searching for some add-ins that might help with this process but have yet to find anything. I am kind of familiar with SQL but not completely. Can I just export the SQL DB and change it all using Excel? I know this would still take some time but it would...

Outlook Attachment security
My system is secure enough, thank you very much. How do you bypass the OL2003 attachment security completely. TIA, Brian Hoover You can't. See http://www.slipstick.com/outlook/esecup/getexe.htm for ways to unblock attachments. For more information on the security features, see http://www.slipstick.com/outlook/esecup.htm -- Diane Poremsky [MVP - Outlook] Author, Teach Yourself Outlook 2003 in 24 Hours Coauthor, OneNote 2003 for Windows (Visual QuickStart Guide) Author, Google and Other Search Engines (Visual QuickStart Guide) Outlook Tips: http://www.outlook-tips.net/ Outlook ...

Deleting Attachments
Hi all, is there a way to delete certain file types like wmv from all the mailboxes found on my exchange 2k3 sp1? On Tue, 27 Jun 2006 09:33:49 +0300, "Nazgyl" <nazgyl@nospamgmail.com> wrote: >Hi all, >is there a way to delete certain file types like wmv from all the mailboxes >found on my exchange 2k3 sp1? > > You can delete messages based on attachment name with Exmerge or use your Exchange aware anti-virus or other 3rd party software... ...

attachement deleted
hi, i have just installed Outlook 2003 and i can't receive any files with extension :exe or reg. i change it with a small programm on Outlook XP but it doesn t work anymore with 2003. does anyone know how to do? thx for your help You'll need to add a registry hack to open the attachments. Look for article 290497 - OL2002: You Cannot Open Attachments, this same fix seems to apply for Outlook 2003 as well. Good luck. >-----Original Message----- >hi, >i have just installed Outlook 2003 and i can't receive any files with >extension :exe or reg. >i change it with...

Outlook will not download messages with attachments
Hi there, Outlook will not let me download email that has attachments bigger than 100kb. Is there a setting to change this. Any help would be appreciated. Thanks. babalas Version of Outlook? Error message? Type of mail account? -- Robert Sparnaaij [MVP-Outlook] www.howto-outlook.com Tips of the month: -What do the Outlook Icons Mean? -Create an Office 2003 CD slipstreamed with Service Pack 1 ----- "babalas" <cedross@sympatico.ca> wrote in message news:Ylspd.66199$Le1.1279134@news20.bellglobal.com... > Hi there, > Outlook will not let me download email that has...

Differences between Bulk email, Email, and Bulk Emails inside Contact?
Hi Buddy, I would like to clarify the main differences between these three attributes, are they affecting the marketing list? If contact "Mr. A" is turn bulk email off, what would happen if we send out a email campaign? Is there any references that would let me to learn more on these attributes? Thanks a million! Below is an excerpt from the CRM help files. I hope this helps. My understanding is that if you select to Allow E-mail and select to Do Not Allow Bulk e-mail that the Contact or Account will receive "regular" e-mail but will not receive e-mail related to ...

Outlook Blocking attachment!
Hi, Can anyone tell me how i stop Outlook 2k blocking my incoming attachments, win2k sp4. Thanks in advance. M. You will have to modify the registry. This can be found in Microsoft Knowledge Base Article - 290497. I have copied the revelant information below. How to Customize Attachment Security Behavior WARNING: If you use Registry Editor incorrectly, you may cause serious problems that may require you to reinstall your operating system. Microsoft cannot guarantee that you can solve problems that result from using Registry Editor incorrectly. Use Registry Editor at your own risk....

Bulk mail arrives in HTML Code
I am using MS Outlook 2002 and am part of 3 Yahoo Groups. E-mail from one of the groups arrives in HTML code. It must be a setting in my Outlook because when I forward the e-mails to my husband's Outlook on the same computer they come through fine. I have re-paired Outlook and even uninstalled it and then re-installed it to no avail. Any ideas? Might help if you actually declared what was your problem. "come though fine" [for husband's computer] doesn't tell us what is wrong on YOUR computer. Also mention WHICH version of Outlook you are using. Different v...

Bulk import in progress but not progressing V3 CRM
Two long Contact imports (40,000+ records) were started and progressing well. One completed but the other appears to be locked. They were both left running after business hours. SQL backups may have impacted them. I can see in the CRM DB where to change the status if they are unrecoverable jobs. But any new bulk imports created are staying in the 'Pending' state. All help welcome. Steve ...