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

Question

我正在尝试下载访问表中的所有附件并将它们存储在 Year\Month 文件夹中。我可以使用这篇文章中的指南下载它们并将它们按 ID 存储在文件夹中。

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

但是，现在我尝试稍微修改一下代码，它会抛出一个错误“76”，提示找不到路径。但是在代码中，我以为我已经使用 If Len(Dir(folder, vbDirectory)) = 0 Then MkDir (folder).... 创建了文件夹。此外，当我在调试模式下将鼠标悬停在 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 进行重构，因此如果需要尾部反斜杠，请将其放回。