Question

所有

我有一个MS Access数据库，其中包含一些文件附件，我需要以编程方式将其复制到另一个MS Access表（两个表都是链接到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 Access实例中的链接表）。

提前致谢。

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中迁移带附件的数据时出现问题

1 个答案: