使用函数和查询从 Access 中保存附件答案

【问题标题】：Saving Attachments from Access with Function and Query使用函数和查询从 Access 中保存附件
【发布时间】：2017-12-11 19:45:24
【问题描述】：

我有一个 MS Access 数据库，其中有一个公共函数和一个查询。我希望该函数遍历“附件”列中的每个字段，然后将所有附件保存在该字段中。我需要将它与“SEDOL”列和相应的行值一起保存为文件名的第一部分，但它一直在下面代码中的“Set rsA2 = fld2.Value”行处出现问题。 SEDOL 列是通常的文本字段列代码在没有 SEDOL 保存名称部分的情况下工作。我喜欢一些关于如何让它工作的建议。谢谢

Public Function SaveAttachments(strPath As String, Optional strPattern As String = "*.*") As Long

Dim dbs As DAO.Database
Dim rst As DAO.Recordset2
Dim rst2 As DAO.Recordset2
Dim rsA As DAO.Recordset2
Dim rsA2 As DAO.Recordset2
Dim fld As DAO.Field2
Dim fld2 As DAO.Field2
Dim strFullPath As String

'Get the database, recordset, and attachment field
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("Core Securities")
Set fld = rst("Attachments")
Set fld2 = rst("SEDOL")
'Navigate through the table
Do While Not rst.EOF

'Get the recordset for the Attachments field
Set rsA = fld.Value
'BUGS IN NEXT LINE
Set rsA2 = fld2.Value
'Save all attachments in the field (works without rsA2)
Do While Not rsA.EOF
    If rsA("FileName") Like strPattern Then
        strFullPath = strPath & "\" & rsA2("SEDOL") & " - " & rsA("FileName")

    'Make sure the file does not exist and save
    If Dir(strFullPath) = "" Then
        rsA("FileData").SaveToFile strFullPath
    End If

    'Increment the number of files saved
    SaveAttachments = SaveAttachments + 1
    End If

    'Next attachment
    rsA.MoveNext
Loop
rsA.Close

'Next record
rst.MoveNext
Loop

rst.Close
dbs.Close

Set fld = Nothing
Set rsA = Nothing
Set rst = Nothing
Set dbs = Nothing

End Function

【问题讨论】：

标签： ms-access vba

【解决方案1】：

由于SEDOL 列只是一个字符串，因此您不能将记录集分配给它的值。

只是参考它的价值：

Public Function SaveAttachments(strPath As String, Optional strPattern As String = "*.*") As Long
    Dim dbs As DAO.Database
    Dim rst As DAO.Recordset2
    Dim rsA As DAO.Recordset2
    Dim strFullPath As String

'Get the database, recordset, and attachment field
    Set dbs = CurrentDb
    Set rst = dbs.OpenRecordset("Core Securities")

'Navigate through the table
    Do While Not rst.EOF
'Get the recordset for the Attachments field
        Set rsA = rst("Attachments").Value
'Save all attachments in the field (works without rsA2)
        Do While Not rsA.EOF
            If rsA("FileName") Like strPattern Then
                strFullPath = strPath & "\" & rst("SEDOL").Value & " - " & rsA("FileName")      
'Make sure the file does not exist and save
                If Dir(strFullPath) = "" Then
                    rsA("FileData").SaveToFile strFullPath
                End If
'Increment the number of files saved
                SaveAttachments = SaveAttachments + 1
            End If
'Next attachment
            rsA.MoveNext
        Loop
        rsA.Close
'Next record
        rst.MoveNext
    Loop

    rst.Close
    dbs.Close

    Set rsA = Nothing
    Set rst = Nothing
    Set dbs = Nothing

End Function

我还删除了许多可能不必要或积极导致错误行为的奇怪东西

【讨论】：