Option Compare Database
Private Sub Command65_Click()
If MsgBox("Confirm?", vbYesNo, "Confirm") = vbYes Then
SaveAttachments "C:\Users\owl\Documents\pic\foldname", "tablename", "fieldname", "key_fieldname"
Else
End If
End Sub
Public Function SaveAttachments(strPath As String, strTable As String, strField As String, strKeyField As String, Optional strPattern As String = "*.*") As Long
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 strID As String
Dim c As Integer, i As Integer, j As Integer
'Get the database, recordset, and attachment field
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset(strTable)
Set fld = rst(strField)
'Navigate through the table
Do While Not rst.EOF
'Get the recordset for the Attachments field
Set rsA = fld.Value
'Save all attachments in the field
Do While Not rsA.EOF
If rsA("FileName") Like strPattern Then
strFullPath = strPath & "\" & rst(strKeyField).Value & "." & LCase(rsA("FileName"))
'Make sure the file does not exist and save
If Dir(strFullPath) = "" Then
rsA("FileData").SaveToFile strFullPath
End If
'Increment the number of files saved
SaveAttachments = SaveAttachments + 1
End If
'Next attachment
rsA.MoveNext
Loop
rsA.Close
'Next record
rst.MoveNext
Loop
rst.Close
dbs.Close
Set fld = Nothing
Set rsA = Nothing
Set rst = Nothing
Set dbs = Nothing
End Function