This is the code I used to import MSSQLdatas.
VBA generates complex and long query with unions, joins and any more.
There create links to MSSQL tables not possible, because there SQL server and MS-ACCESS are different machines and connection only via RDP.
This code generates Recordset and saves her to DROPBOX in ADTG format.
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
This code downloads saved ADTG from dropbox and writes to table.
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
There exists some way to directly write ADTG recordset to access table without step-by-step looping, like Docmd.TransferDatabase or etc ?