MS Access VBA下载附件Mkdir路径不存在

Question

我试图下载Access表中的所有附件并按Year \ Month文件夹存储它们。我可以使用此帖子中的指南下载它们并通过ID将它们存储在文件夹中。

MS-Access VBA - Trying to extract each file in a table's attachments to disk?

但是，现在我尝试稍微修改一下代码，它会抛出一个错误'76'，表示路径未找到。但是在代码中，我以为我正在创建已经使用If Len的文件夹（Dir（文件夹，vbDirectory））= 0然后MkDir（文件夹）....还有，当我在调试模式下将鼠标悬停在mkdir上时，它说：文件夹=“C：\ Personal \ Desktop \ a \ 2014 \ 11 \”这是我桌子上的第一批产品

有人可以帮忙吗？

该表包含列年，月，附件。目标是按照以下格式将所有附件按年份和月份放置：“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

您的问题可能是一个或多个较低级别的文件夹不存在。您应该在循环之前检查每个级别，前三个，然后因为您使用年和月作为进一步的子文件夹，它们也需要在循环内一次检查一个。

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

我不确定，但我怀疑.SaveToFolder的参数是否需要一个反斜杠，所以请注意我在更改代码时将其删除，并将其称为afolder以避免混淆并允许基于folder的重建如果需要尾随反斜杠，请将其重新插入。