使用函数和查询保存Access的附件

时间:2017-12-11 19:45:24

标签: ms-access access-vba

我有一个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

1 个答案:

答案 0 :(得分: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

我还删除了许多可能不必要或者主动导致错误行为的奇怪事情