在 Access 中迁移带有附件的数据时遇到问题

Question

全部，

我有一个 MS Access 数据库，其中有一些文件附件，我需要以编程方式将其复制到另一个 MS Access table（两个 table 都链接 table 到 SharePoint 2007 年名单）。我有以下代码。

Private Sub AddAttachments(rsSource As Recordset, rsDest As Recordset)
    Dim rs2Source As Recordset2
    Dim rs2Dest As Recordset2
    Set rs2Source = rsSource.Fields!Attachments.Value
    Set rs2Dest = rsDest.Fields("Attachments").Value
    rs2Source.MoveFirst
    If Not (rs2Source.BOF And rs2Source.EOF) Then
        While Not rs2Source.EOF
            rs2Dest.AddNew
            rs2Dest!FileData = rs2Source!FileData
            rs2Dest.Update
            rs2Source.MoveNext
        Wend
    End If
    Set rs2Source = Nothing
    Set rs2Dest = Nothing
End Sub

我的问题是，当它到达 rs2Dest!FileData = rs2Source!FileData 时，它一直给我一个无效参数错误。因此，如果我尝试做的是可能的，我如何调整我的代码以从一个列表中读取附件数据并将其导入另一个列表（在 MS 的一个实例中都链接为 linked-tables访问）。

提前致谢。

Answer 1

全部，

这是我想出的笨拙解决方案，以防对其他人有帮助。

首先，我需要访问 URLmon 库的 URLDownloadToFileA 函数。

Private Declare Function URLDownloadToFileA Lib "urlmon" (ByVal pCaller As Long, ByVal szURL As String, ByVal szfilename As String, ByVal dwreserved As Long, ByVal ipfnCB As Long) As Long

然后，我会使用这个库将文件下载到我的磁盘，从我的磁盘上传，并删除临时存储的文件如下：

Private Function DownloadFile(URL As String, LocalFilename As String) As Boolean
    DownloadFile = (URLDownloadToFileA(0, URL, LocalFilename, 0, 0) = 0)
End Function

Private Function GetRight(strText As String, FindText As String) As String
    Dim i As Long
    For i = Len(strText) - Len(FindText) + 1 To 1 Step -1
        If Mid(strText, i, Len(FindText)) = FindText Then
            GetRight = Mid(strText, i + 1, Len(strText))
            Exit For
        End If
    Next i
End Function

Private Sub AddAttachments(rsSource As Recordset, rsDest As Recordset)
    Dim rs2Source As Recordset2
    Dim rs2Dest As Recordset2
    Set rs2Source = rsSource.Fields!Attachments.Value
    Set rs2Dest = rsDest.Fields("Attachments").Value
    Dim strDownload As String
    Dim strTemp As String
    strTemp = Environ$("TEMP")
    If Not (rs2Source.BOF And rs2Source.EOF) Then
        rs2Source.MoveFirst
        If Not (rs2Source.BOF And rs2Source.EOF) Then
            While Not rs2Source.EOF
                rs2Dest.AddNew
                'rs2Dest.Update
                'rs2Dest.MoveLast
                'rs2Dest.Edit
                strDownload = strTemp & "\" & GetRight(rs2Source!FileURL, "/")
                Debug.Print DownloadFile(rs2Source!FileURL, strDownload)
                rs2Dest.Fields("FileData").LoadFromFile strDownload
                rs2Dest.Update
                rs2Source.MoveNext
                Kill strDownload 'delete the temporarily stored file
            Wend
        End If
    End If
    Set rs2Source = Nothing
    Set rs2Dest = Nothing
End Sub

我确定有更简单的方法，但这似乎适合我的目的（尽管笨拙的方式只适合 VBA 之类的人）。

在 Access 中迁移带有附件的数据时遇到问题

Having issues migrating data with attachments in Access

ms-access

vba

dao

sharepoint-2007

attachment-field