-1

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 ?

1 Answers1

1

The best - or at least most flexible - method is to link the MySQL table via ODBC, then create an append query that uses this table as source and writes to your Access table.

In this query, you can setup conversion, filters, and perhaps some validation.

Data can easily be viewed, and the query be debugged, before you finally run the query to import the sanitised data.

Gustav
  • 53,498
  • 7
  • 29
  • 55