直接将ADTG文件写入MS Access表

时间:2018-07-10 09:24:53

标签: ms-access import access-vba dropbox-api winhttprequest

这是我用来导入MSSQLdatas的代码。 VBA使用联合,联接等来生成复杂而冗长的查询。 无法创建到MSSQL表的链接,因为那里的SQL Server和MS-ACCESS是不同的机器,并且只能通过RDP进行连接。
这段代码生成Recordset并将其以ADTG格式保存到DROPBOX。

        Set xrs = ExecuteSQL_rs(SqlStr, True, "", "Wait")
    If Not xrs Is Nothing Then
    Dim stm As ADODB.Stream
    Set stm = New ADODB.Stream
    stm.Type = adTypeBinary
    Dim http As WinHttp.WinHttpRequest
    stm.Open
    xrs.Save stm, adPersistADTG

    Set http = CreateObject("WinHttp.WinHttpRequest.5.1")
    lngTimeout = 89000
    http.setTimeouts lngTimeout, lngTimeout, lngTimeout, lngTimeout

    http.Open "POST", "https://content.dropboxapi.com/2/files/upload", False
    http.setRequestHeader "Content-Length", stm.Size
    http.setRequestHeader "Authorization", "Bearer f0IeL0jRJbAAAAAAADAAAUdasSDDdarxM974olpjQiofsdf0JW4wT_XrbDGkMWVz-cA9F_U"
    http.setRequestHeader "User-Agent", "api-explorer-client"
    http.setRequestHeader "Content-Type", "application/octet-stream"
    http.setRequestHeader "Dropbox-API-Arg", "{""path"":""/ANT.accdb"",""mode"":{"".tag"":""overwrite""},""autorename"":true}"
'    http.setRequestHeader "Host", "https://content.dropboxapi.com"
    http.send (stm.Read)
    Set smt = Nothing
    If http.Status = 200 Then
        MsgBox ("Upload completed." & Chr(13) & Now())
    Else
        MsgBox ("There is ERROR " & http.Status)
    End If

此代码从保管箱下载保存的ADTG并写入表中。

Set http = CreateObject("WinHttp.WinHttpRequest.5.1")
http.Open "POST", "https://content.dropboxapi.com/2/files/download", False
http.setRequestHeader "Authorization", "Bearer " & Token

http.setRequestHeader "User-Agent", "api-explorer-client"
http.setRequestHeader "Dropbox-API-Arg", "{""path"":""/ANT.accdb""}"
http.send
Set xRs = CreateObject("ADODB.Stream")
xRs.Type = 1
xRs.Mode = 3
xRs.Open
xRs.Write (http.ResponseBody)
xRs.Position = 0
Set xRs1 = CreateObject("ADODB.Recordset")
xRs1.Open xRs
Call AddADODBtoDAO(xRs1, rsLocal)

Sub AddADODBtoDAO(RSold, RSNew)
    Dim fieldCount As Integer
    fieldCount = RSold.Fields.Count - 1
    Dim i As Long
    Do While Not RSold.EOF
     RSNew.AddNew
        For i = 0 To fieldCount
            RSNew.Fields(RSold.Fields(i).Name) = RSold.Fields(i).Value
        Next i
    RSNew.Update
    RSold.MoveNext
Loop
End Sub

有一些方法可以直接将ADTG记录集写入访问表而无需逐步循环,例如Docmd.TransferDatabase或类似方法?

1 个答案:

答案 0 :(得分:1)

最好(或至少最灵活)的方法是通过ODBC链接MySQL表,然后创建一个使用该表作为源并将其写入Access表的追加查询。

在此查询中,您可以设置转化,过滤器,也许还可以进行一些验证。

在最终运行查询以导入经过清理的数据之前,可以轻松查看数据并调试查询。