MS ACCESS : SaveAttachments file

Posted by Datebase MS ACCESS : SaveAttachments file에 댓글 닫힘


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