Load pictures into attachment data type with linked file names in access-CodePudding

So I have a table in access with file names I have been using as links in a form to view pictures. I would like to move these into an attachment database of photos so I can distribute the database to others without having to copy the file path names too.

I started some code to try it but not sure how to loop through the file paths because I have specific images I choose.

Here is an example of some of the data...so I would take the Tassel photo filepath and upload the picture to column PhotoT with datatype attachment.

Option Compare Database
Option Explicit


Sub test()
Dim dbs As DAO.Database

    Dim rst As DAO.Recordset2
    Dim rsA As DAO.Recordset2
    Dim fld As DAO.Field2
    Dim strFullPath As String
    Dim noRows As String
    'Get the database, recordset, and attachment field
    Set dbs = CurrentDb
    Set rst = dbs.OpenRecordset("InbredPicPaths")
    Set fld = rst("Tassel")
    Dim strPath As String
    Dim strFile As String
    Dim i As Integer
    
   ' Set pho = rst("PhotoT")
   noRows = FindRecordCount("InbredPicPaths")
   
   'Navigate through the table
    Do While Not rst.EOF
    
        'Get the recordset for the Attachments field
      Do While i <= noRows
       ' Set rsA = Image.Value

        'Debug.Print rst.Fields("ImageFileName").Value
        If fld <> "" Then
         strPath = fld
        
         strFile = rst.Fields("*_T.JPG").Value
      
         Debug.Print strPath & "\" & strFile
         rst.Edit
         rsA.AddNew
         rsA("FileData").LoadFromFile strPath & "\" & strFile
         rsA.Update
          rsA.Close
        
         rst.Update
         'Next record
         rst.MoveNext
         
        'Set strPath = Nothing
        'Set strFile = Nothing
        
        End If
        

        i = i   1
        
        Loop
        
    Loop
    
    Set rst = Nothing
    Set rsA = Nothing
    Set fld = Nothing
    
End Sub



'This is a function to count rows in table

Function FindRecordCount(strSQL As String) As Long
 
Dim dbsNorthwind As DAO.Database
Dim rstRecords As DAO.Recordset
 
On Error GoTo ErrorHandler
 
   Set dbsNorthwind = CurrentDb
 
   Set rstRecords = dbsNorthwind.OpenRecordset(strSQL)
 
   If rstRecords.EOF Then
      FindRecordCount = 0
   Else
      rstRecords.MoveLast
      FindRecordCount = rstRecords.RecordCount
   End If
 
   rstRecords.Close
   dbsNorthwind.Close
 
   Set rstRecords = Nothing
   Set dbsNorthwind = Nothing
 
Exit Function
 
ErrorHandler:
   MsgBox "Error #: " & Err.Number & vbCrLf & vbCrLf & Err.Description
End Function

CodePudding user response：

So from the picture it looks like you need to iterate through the rows of a table with a column containing the url of a file and then attach that file to an attachment type column in the same file. Assuming:

Here is code that does that.

Public Sub MovethroughTableAttachingPhotos(TableName As String, urlColumnName As String, attachmenttypeColumnName As String)
'adapted from  https://docs.microsoft.com/en-us/office/vba/access/concepts/data-access-objects/work-with-attachments-in-dao
Dim db As Database
Set db = CurrentDb
Dim rsTable As Recordset
Dim rsPhotos As Recordset
Set rsTable = db.OpenRecordset(TableName)
rsTable.MoveFirst 'avoids an error
Dim currentURL As String
Do Until rsTable.EOF
currentURL = rsTable(urlColumnName)
rsTable.Edit
Set rsPhotos = rsTable.Fields(attachmenttypeColumnName).value
rsPhotos.AddNew
rsPhotos.Fields("FileData").LoadFromFile (currentURL)
rsPhotos.Update
rsPhotos.Close 'placing here avoids an error
rsTable.Update
rsTable.MoveNext
Loop
'clean up
rsTable.Close 
Set rsPhotos = Nothing
Set rsTable = Nothing
Set db = Nothing
End Sub

'to call the subroutine : MovethroughTableAttachingPhotos "Photos", "PhotoAddress", "PhotoAttachment"