MS Access VBA将单个附件保存到文件夹

Question

我是Access的新手，所以我还没有听说过Access VBA的大部分命令，但我对Excel VBA非常熟悉。

我要做的是保存刚刚通过表单输入表格的附件。我一直在网上看一些例子并尝试让它为我工作，但代码没有将文件移动到文件夹。我没有收到调试错误。

这是我目前的代码。我知道它现在已经设置为循环，我真的只想在表中最后一个附件，但我不知道如何只获得最后一个附件。无论哪种方式，此当前代码不会移动任何附件。

Private Sub cmdAddRecord_Click()

If MsgBox("Adding a new record will save the current form. You will not be able to edit this credit request. Would you like to continue?", vbQuestion + vbYesNo, "Save current record and open new form") = vbYes Then

MkDir "C:\Users\username\Desktop\IC Transfer Back Up Attachments\" & Me.txtRequestID & "-" & "Back Up Attachments" & " " & Format(Date, "MMDDYY")

DoCmd.RunCommand acCmdSaveRecord

Dim SaveFolder As String
SaveFolder = "C:\Users\username\Desktop\IC Transfer Back Up Attachments\" & Me.txtRequestID & "-" & "Back Up Attachments" & " " & Format(Date, "MMDDYY")

Dim rsParent As DAO.Recordset2
Dim rsChild As DAO.Recordset2
Set rsParent = CurrentDb.OpenRecordset("SELECT * FROM tblICTRequested")
Set rsChild = rsParent.Fields("BackUpAttachments").Value

Do Until rsChild.EOF
    rsChild.Fields("FileData").SaveToFile SaveFolder
    rsChild.MoveNext
Loop

    DoCmd.RunCommand acCmdCloseWindow
    DoCmd.OpenForm "frmICTRequested"

End If
End Sub

大多数这似乎对我有意义，但我不确定我应该放在.Fields("FileData").SaveToFile行，因为我没有名为“FileData”的字段，但我已经尝试了所有现有的字段无济于事。

作为参考，以下是我查看的一些在线链接：

https://www.experts-exchange.com/questions/29005769/MS-Access-attachment-file.html https://msdn.microsoft.com/en-us/library/office/ff191852.aspx https://access-programmers.co.uk/forums/showthread.php?t=282135

有小费吗？非常感激！

Answer 1

所以在某人的帮助下，我改变了界限：

Set rsParent = CurrentDB.OpenRecordset("SELECT * FROM tblICTRequested")

至：

Set rsParent = CurrentDB.OpenRecordset("SELECT * FROM tblICTRequested WHERE ID =" & Me.txtRequestedID)

这似乎完全符合我的目的！感谢所有提供信息的人！

Answer 2

你很近。我使用这样的函数：

Public Function SaveFileToDisk(FileName As String, FileData As DAO.Field2, Optional saveToFolder As String) As String
    Dim templatePath As String

    If saveToFolder = "" Or Not fso.FolderExists(saveToFolder) Then
        saveToFolder = Environ("temp")
    End If

    templatePath = GetAvailableFileName(FileName, saveToFolder, True) 'A function to create a unique file name

    FileData("FileData").SaveToFile templatePath
    SaveTemplateToDisk = templatePath
End Function

它被调用如下：

Dim tempPath As String
Dim fileData as DAO.Field2
Dim folderToSaveTo as string

folderToSaveTo = "C:\some\folder"
set fileData = rsParent.Fields("BackUpAttachments")
tempPath = exporter.SaveTemplateToDisk("Name of file.ext", fileData , folderToSaveTo)

附件字段有点像字段中的记录集。