-1

这是我用来导入 MSSQLdatas 的代码。VBA 使用联合、连接等生成复杂而冗长的查询。不可能创建到 MSSQL 表的链接,因为那里的 SQL 服务器和 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 等?

4

1 回答 1

1

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

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

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

于 2018-07-10T10:03:29.573 回答