MS Access VBA download attachment Mkdir path not exist - ms-access

Question

I am attempting to download all the attachments in the Access Table and store them by Year\Month folder. I am able to download them and store them in folders by ID using the guideline from this post.
MS-Access VBA - Trying to extract each file in a table's attachments to disk?
However, now I try to modify the code a bit and it throws me an error'76' saying Path not Found. But in the code, I thought I was creating the folder already using If Len(Dir(folder, vbDirectory)) = 0 Then MkDir (folder).... also, when I hover over mkdir in debug mode, it said: folder = "C:\Personal\Desktop\a\2014\11\" which is the first couple items on my table
Can someone please help?
The table has column Year, Month, Attachments.
The goal is to place all the attachments according to Year and Month in this format: "C:\Personal\Desktop\a\YEAR\MONTH\"
Sub a()
Dim database As DAO.database
Dim table As DAO.Recordset
Dim PONum As String
Dim folder As String
Set database = CurrentDb
Dim PKey As String
Dim P2Key As String
Set table = database.OpenRecordset("NIS")
With table ' For each record in table
Do Until .EOF 'exit with loop at end of table
Set Attachments = table.Fields("Attachments").Value 'get list of attachments
PKey = table.Fields("Year").Value ' get record key
P2Key = table.Fields("Month").Value
folder = "C:\Personal\Desktop\a\" & PKey & "\" & P2Key & "\" 'initialise folder name to create
If Len(Dir(folder, vbDirectory)) = 0 Then ' if folder does not exist then create it
MkDir (folder)
End If
' Loop through each of the record's attachments'
While Not Attachments.EOF 'exit while loop at end of record's attachments
' Save current attachment to disk in the above-defined folder.
Attachments.Fields("FileData").SaveToFile (folder)
Attachments.MoveNext 'move to next attachment
Wend
.MoveNext 'move to next record
Loop
End With
End Sub

Answer 1

Your problem is likely that one or more of the lower-level folders does not exist. You should check for each level, the first three one at a time before the loop, then because you use year and month as further subfolders, they need to be checked also one at a time inside the loop.
folder = "C:\Personal"
If Len(Dir(folder, vbDirectory)) = 0 Then
MkDir folder
End If
folder = folder & "\Personal"
If Len(Dir(folder, vbDirectory)) = 0 Then
MkDir folder
End If
folder = folder & "\a"
If Len(Dir(folder, vbDirectory)) = 0 Then
MkDir folder
End If
With table ' For each record in table
Do Until .EOF 'exit with loop at end of table
Set Attachments = table.Fields("Attachments").Value 'get list of attachments
PKey = table.Fields("Year").Value ' get record key
If Len(Dir(folder & "\" & PKey, vbDirectory)) = 0 Then
MkDir folder * "\" & Pkey
End If
P2Key = table.Fields("Month").Value
If Len(Dir(folder & "\" & PKey & "\" & PKey2, vbDirectory)) = 0 Then
MkDir folder * "\" & Pkey & "\" & PKey2
End If
afolder = folder & "\" & PKey & "\" & P2Key ' folder name for save
' Loop through each of the record's attachments'
While Not Attachments.EOF 'exit while loop at end of record's attachments
' Save current attachment to disk in the above-defined folder.
Attachments.Fields("FileData").SaveToFile (afolder)
Attachments.MoveNext 'move to next attachment
Wend
.MoveNext 'move to next record
Loop
End With
I'm not certain, but I doubt that the parameter for .SaveToFolder expects a trailing backslash so please take note that I removed it in my alteration to your code, and also called it afolder to avoid confusion and to allow the reconstruction based on folder so if a trailing backslash is required, put it back in.