Warning: file_get_contents(/data/phpspider/zhask/data//catemap/1/ms-access/4.json): failed to open stream: No such file or directory in /data/phpspider/zhask/libs/function.php on line 167

Warning: Invalid argument supplied for foreach() in /data/phpspider/zhask/libs/tag.function.php on line 1116

Notice: Undefined index: in /data/phpspider/zhask/libs/function.php on line 180

Warning: array_chunk() expects parameter 1 to be array, null given in /data/phpspider/zhask/libs/function.php on line 181

Warning: file_get_contents(/data/phpspider/zhask/data//catemap/0/vba/14.json): failed to open stream: No such file or directory in /data/phpspider/zhask/libs/function.php on line 167

Warning: Invalid argument supplied for foreach() in /data/phpspider/zhask/libs/tag.function.php on line 1116

Notice: Undefined index: in /data/phpspider/zhask/libs/function.php on line 180

Warning: array_chunk() expects parameter 1 to be array, null given in /data/phpspider/zhask/libs/function.php on line 181

Warning: file_get_contents(/data/phpspider/zhask/data//catemap/6/ant/2.json): failed to open stream: No such file or directory in /data/phpspider/zhask/libs/function.php on line 167

Warning: Invalid argument supplied for foreach() in /data/phpspider/zhask/libs/tag.function.php on line 1116

Notice: Undefined index: in /data/phpspider/zhask/libs/function.php on line 180

Warning: array_chunk() expects parameter 1 to be array, null given in /data/phpspider/zhask/libs/function.php on line 181
Ms access 在Access中迁移带有附件的数据时出现问题_Ms Access_Vba_Sharepoint 2007_Dao_Attachment Field - Fatal编程技术网

Ms access 在Access中迁移带有附件的数据时出现问题

Ms access 在Access中迁移带有附件的数据时出现问题,ms-access,vba,sharepoint-2007,dao,attachment-field,Ms Access,Vba,Sharepoint 2007,Dao,Attachment Field,全部, 我有一个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 =

全部,

我有一个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实例中的链接表链接

提前感谢。

所有

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

首先,我需要访问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这样的人