Hello,
I have found a code that saves all attachments in a table called "attachments" to a folder. I have modified it and got it to work, but the problem I have now is incrementing the file name by one every time a file name already exist. Below is the code I have.
Private Sub Command38_Click()
Dim dbs As DAO.Database
Dim rst As DAO.Recordset2
Dim rsA As DAO.Recordset2
Dim fld As DAO.Field2
Dim strPath As String
Dim strFullPath As String
Dim strPattern As String
strPattern = "*.*"
On Error GoTo ErrorHandel
'Get the database, recordset, and attachment field
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("Attachments")
Set fld = rst("Field1")
'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 = "I:\HumRes\FP\Communication\Attachment" & "\" & rsA("FileName")
'Make sure the file does not exist and save
If Dir(strFullPath) = "" Then
rsA("FileData").SaveToFile strFullPath
Else
'Increment the number of files saved
fld.Value = fld.Value + 1
rsA("FileData").SaveToFile strFullPath
End If
End If
'Next attachment
rsA.MoveNext
Loop
rsA.Close
'Next record
rst.MoveNext
Loop
ErrorHandel:
MsgBox "Error: (" & Err.Number & ") " & Err.Description, vbCritical
rst.Close
dbs.Close
Set fld = Nothing
Set rsA = Nothing
Set rst = Nothing
Set dbs = Nothing
End Sub
I have looked around and tried different things but VBA is not a strong suit for me. The goal of this code is to save all attachments in the table to folder.
Thank You for any info/help on this,
KDC900