This is in reference to code posted in this post https://www.access-programmers.co.uk/forums/threads/export-attachments-to-folders.299345/
I didn't want to hijack that thread so I started a new one - please let me know if I need to move my questions over to that thread.
So, the following code is working fine as far as pulling the pictures (attachments) and saving them (saving them with the AIS value + file name, and it's doing fine creating the folders titled with the AIS field appropriately; However, it isn't placing the pictures (attachments) inside the appropriate folder. So the output I'm getting now is empty folders (titled properly), and then all the pictures in the same directory as all the empty folders (titled properly). I guess I'm getting my onClick Call wrong. Any advice of the correct way so I can get the pictures put into their appropriate folders? Thanks!
I didn't want to hijack that thread so I started a new one - please let me know if I need to move my questions over to that thread.
So, the following code is working fine as far as pulling the pictures (attachments) and saving them (saving them with the AIS value + file name, and it's doing fine creating the folders titled with the AIS field appropriately; However, it isn't placing the pictures (attachments) inside the appropriate folder. So the output I'm getting now is empty folders (titled properly), and then all the pictures in the same directory as all the empty folders (titled properly). I guess I'm getting my onClick Call wrong. Any advice of the correct way so I can get the pictures put into their appropriate folders? Thanks!
Code:
Public Function SaveAttachmentsTest(strPath As String, Optional strPattern As String = "*.*") As Long
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim rsA As DAO.Recordset2
Dim rsB As String
Dim fld As DAO.Field2
Dim OrdID As DAO.Field2
Dim strFullPath As String
Dim thisPath As String
'Get the database, recordset, and attachment field
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("Persons")
Set fld = rst("Attachments")
Set OrdID = rst("AIS")
'Navigate through the table
Do While Not rst.EOF
'Get the recordset for the Attachments field
Set rsA = fld.Value
rsB = OrdID.Value
'Save all attachments in the field
Do While Not rsA.EOF
Set OrdID = rst("AIS")
If rsA("FileName") Like strPattern Then
'To Export the data, use the line below
thisPath = Replace(strPath & "" & OrdID & "", "\", "")
subMakePath thisPath
strFullPath = thisPath & 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
SaveAttachmentsTest = SaveAttachmentsTest + 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
Private Sub subMakePath(NewPath As String)
Dim var, direc
Dim sPath As String
var = Split(NewPath, "")
For Each direc In var
sPath = sPath & direc & ""
If Dir(sPath, vbDirectory) = "" Then
MkDir sPath
End If
Next
End Sub
Private Sub Command0_Click()
'Call SaveAttachmentsTest - argument not optional
'Call SaveAttachmentsTest("") - saves ais folder and adds ais to photo name but not putting photos in folders
End Sub