这是我用来导入 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 等?