0

全部,

我有一个 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 时,它一直给我一个 Invalid Argument 错误。因此,如果我尝试做的事情是可能的,我该如何调整我的代码以从一个列表中读取附件数据并将其导入另一个列表(在 MS Access 的实例中都链接为链接表)。

提前致谢。

4

1 回答 1

0

全部,

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

首先,我需要访问 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 之类的)。

于 2015-02-02T21:38:27.463 回答