Extract a SQL Query from a Database Server Directly to Text File Using VBA

There are many reasons why one would not first import the results of a SQL query into an Access table or Excel spreadsheet. One reason is that the data may be too large and would exceed the 2GB limit of Access or perhaps the extract is meant to be a text load file for another program like LSMW.

The code is relatively simple, so there is no need to break it down and explain each piece. It is provide here for easy recycling and is enriched with remarks to make the code easier to understand.

Update: Some code is added to deal with shoddy network connections breaking the extract in the middle. In order for it to work, the SQL code must include an ORDER BY clause because the error-catching code adds an OFFSET n ROWS clause at the end. While in a corporate office, the network connection works just fine, but while working from home using a residential-quality internet connection and a too-busy VPN server, the network connection can be very buggy.

Function ExtractSQLServerToText(strODBC As String, strSQL As String, strTextFile As String, Optional isAppend As Boolean = False) As Long

    Dim x, nCurSec As Long
    Dim nRecordCount As Long
    Dim nWait As Long
    'ODBC Example 1: DRIVER=SQL Server;SERVER=domain\servername;UID=userid;PWD=password;APP=Microsoft Office 2003;WSID=Computer;DATABASE=database;Trusted_Connection=No
    'ODBC Example 2: DRIVER=SQL SERVER;SERVER=domain\servername;DATABASE=database;Trusted_Connection=Yes
    
    'SQL Example 1: select * from MARA
    'SQL Example 2: select mara.matnr, makt.maktx from mara join makt on (mara.matnr=makt.maktx and makt.spras='E')
    
    
    'Setup for the ADODB connection to SQL Server
    Dim db As ADODB.Connection
    Dim objCat As ADOX.Catalog
    Dim objTbl As ADOX.Table
    Dim objInd As ADOX.Index
    Dim objCol As ADOX.Column
    Dim objRS As ADODB.Recordset
    Dim objFld As ADODB.Field
    
    'Setup the local connection in this database.
    Dim dbs As DAO.Database
    Set dbs = CurrentDb
    Dim tdf As DAO.TableDef
    Dim fld As DAO.Field
    Dim fName As String
    Dim fType As Integer
    Dim fSize As Integer
    Dim rs As DAO.Recordset
    
    Dim strOutput As String
    
    Dim RetVal As Variant
    RetVal = SysCmd(acSysCmdSetStatus, "Creating " & strTextFile & "...")
    RetVal = DoEvents()
    
    Set db = New ADODB.Connection
    db.CommandTimeout = 0
    db.ConnectionString = strODBC
    db.Open
    Set objRS = New ADODB.Recordset

    objRS.Open strSQL, db
    
    
    If isAppend Then
        Open strTextFile For Append As #2
    Else
        Open strTextFile For Output As #2
        strOutput = ""
        'Make the first row the field names.
        For Each objFld In objRS.FIELDS
            If strOutput <> "" Then
                strOutput = strOutput & vbTab
            End If
            strOutput = strOutput & objFld.Name
        Next
        Print #2, Trim(strOutput)
    End If
    
    nCurrent = 0
    
    GoTo SkipErrorHandler
    
ErrorHandler:
    nWait = 20
    Do While nWait > 0
        nWait = nWait - 1
        RetVal = SysCmd(acSysCmdSetStatus, "Pausing because of error..." & nWait & "  Creating " & strTextFile & "... " & nRecordCount & " records")
        nCurrentSec = Second(Now)
        Do While nCurrentSec = Second(Now)
            RetVal = DoEvents()
        Loop
    Loop
    
    objRS.Close
    db.Close
    db.Open
    objRS.Open strSQL & " offset " & nRecordCount & " rows", db
    
SkipErrorHandler:
    On Error GoTo ErrorHandler
    'Step through the records and write them out to the text file.
    Do While Not objRS.EOF
        nRecordCount = nRecordCount + 1
        strOutput = ""
        For Each objFld In objRS.FIELDS
            If strOutput <> "" Then
                strOutput = strOutput & vbTab
            End If
            strOutput = strOutput & Trim("" & objFld.Value)
        Next
        Print #2, Trim(strOutput)

        objRS.MoveNext
        If Second(Now()) <> nCurSec Then
            nCurSec = Second(Now())
            RetVal = SysCmd(acSysCmdSetStatus, "Creating " & strTextFile & "... " & nRecordCount & " records")
            RetVal = DoEvents()
        End If
        
    Loop
    Close #2
    objRS.Close
    
    RetVal = SysCmd(acSysCmdClearStatus)
    ExtractSQLServerToText = nRecordCount
End Function

Things to watch for . . .

If the SQL results are larger than 2GB, but still need to be used in Access then this function can be used to extract the results to a text file and then this function can be used to create a linked table using the text file. Automating these steps using a macro or a snippet of VBA code makes exceeding Access' 2GB limit easy.

If the server uses Windows credentials (trusted connection) and the server is on a separate domain from the workstation then it will be necessary to use the runas command to launch msaccess.exe. It is not enough to launch a CMD window and then start the file or even run the msaccess.exe program from a CMD window that is already runas the user from the other domain.

References available upon request

VBA depends on many Dynamic-link Libraries (DLLs) to make this code work. Be sure to include the libraries below in VBA by clicking Tools → References and adding the most recent versions available of these libraries.