VBA附件:在集合中找不到项目

时间:2016-04-07 20:41:09

标签: vba ms-access attachment-field

所有

我正在尝试将1条记录的记录保存到驱动器中。我花了大约一天的时间寻找解决方案,所以这是最后的努力以获得一些帮助。我不是想象力的开发者,所以请放轻松。

代码如下。

记录所在的表:跟踪器。

我正在搜索的字段:ReqID - 其中ReqID =我输入的记录,找到附件并将其移动到某个位置。

Dim db As DAO.Database
Dim rsChild As DAO.Recordset2
Dim ReqID As String

ReqID = Me.Form![Text145]
Debug.Print ReqID

Set db = CurrentDb
Set rsChild = db.OpenRecordset("Select * from tracker Where " & ReqID & " = [tracker].[ID]", dbOpenDynaset)
Debug.Print rsChild.RecordCount



   If (rsChild.EOF = False) Or (rsChild.BOF = False) Then

    While Not rsChild.EOF
rsChild("FileData").SaveToFile "C:\Users\<folder>\"
        rsChild.Delete
    Wend
    End If

1 个答案:

答案 0 :(得分:1)

您实际上需要使用两个Recordset对象:一个用于主记录,另一个用于与该记录关联的附件。这是适用于我的示例代码,其中[tblTest]是表的名称,[Attachments]是Attachment字段的名称:

Option Compare Database
Option Explicit

Sub SaveAllAttachments()
    Dim cdb As DAO.Database
    Set cdb = CurrentDb
    Dim rstMain As DAO.Recordset
    Set rstMain = cdb.OpenRecordset("SELECT Attachments FROM tblTest WHERE ID=1", dbOpenDynaset)
    rstMain.Edit
    Dim rstChild As DAO.Recordset2
    Set rstChild = rstMain.Fields("Attachments").Value
    Do Until rstChild.EOF
        Dim fileName As String
        fileName = rstChild.Fields("FileName").Value
        Debug.Print fileName
        Dim fld As DAO.Field2
        Set fld = rstChild.Fields("FileData")
        fld.SaveToFile "C:\Users\Gord\Desktop\" & fileName
        rstChild.Delete  ' remove the attachment
        rstChild.MoveNext
    Loop
    rstChild.Close
    rstMain.Update
    rstMain.Close
End Sub