VBA macro save SQL query in a csv file

Question

I am working on a VBA macro which connects to my database on SQL Server and run some queries and save the results on CSV files... it works fine just when the queries returns

Answer 1

you should go with your .EOF solution. Here is an example of mine, which I use regularly.

Sub AnySub()

    ''recordsets
    Dim rec as ADODB.Recordset

    ''build your query here
    sSql = "SELECT * FROM mytable where 1=0" ''just to have no results

    ''Fire query
    Set rec = GetRecordset(sSql, mycnxnstring)

    ''and then loop throug your results, if there are any
    While rec.EOF = False

        ''do something with rec()
        rec.MoveNext
    Wend
End sub

Here the Function GetRecordset() is given by:

Function GetRecordset(strQuery As String, connstring As String) As Recordset
    Dim DB As ADODB.Connection
    Dim rs As ADODB.Recordset
    Set DB = New ADODB.Connection
    With DB
        .CommandTimeout = 300
        .ConnectionString = connstring
        .Open
    End With
    Set GetRecordset = DB.Execute(strQuery)

End Function

Hope this helps.

Answer 2

If you experience problems connecting to your server then this is due to any of the following:

1. an incorrect connection string
2. incorrect credentials
3. the server is not reachable (for example: network cable disconnected)
4. the server is not up and running

Sending a query to a server which results in an empty recordset is not a reason for an ADODB.Connection to fail.

Here is a little bit of code for you to try and debug the connection in a first step and then the query in a second step:

Option Explicit

Public Sub tmpSO()

Dim strSQL As String
Dim strServer As String
Dim strDatabase As String
Dim OutMail As Outlook.MailItem
Dim rstResult As ADODB.Recordset
Dim conServer As ADODB.Connection
Dim OutApp As Outlook.Application

strServer = "."
strDatabase = "master"

Set conServer = New ADODB.Connection
conServer.ConnectionString = "PROVIDER=SQLOLEDB; " _
    & "DATA SOURCE=" & strServer & ";" _
    & "INITIAL CATALOG=" & strDatabase & ";" _
    & "User ID='UserNameWrappedInSingleQuotes'; " _
    & "Password='PasswordWrappedInSingleQuotes'; "
On Error GoTo SQL_ConnectionError
conServer.Open
On Error GoTo 0

strSQL = "set nocount on; "
strSQL = strSQL & "select  * "
strSQL = strSQL & "from    sys.tables as t "
strSQL = strSQL & "where   t.name = ''; "

Set rstResult = New ADODB.Recordset
rstResult.ActiveConnection = conServer
On Error GoTo SQL_StatementError
rstResult.Open strSQL
On Error GoTo 0

If Not rstResult.EOF And Not rstResult.BOF Then
    ThisWorkbook.Worksheets(1).Range("A1").CopyFromRecordset rstResult
'    While Not rstResult.EOF And Not rstResult.BOF
'        'do something
'        rstResult.MoveNext
'    Wend
Else
    'https://msdn.microsoft.com/en-us/library/windows/desktop/ms675546(v=vs.85).aspx
    Select Case conServer.State
        'adStateClosed
        Case 0
            MsgBox "The connection to the server is closed."
        'adStateOpen
        Case 1
            MsgBox "The connection is open but the query did not return any data."
        'adStateConnecting
        Case 2
            MsgBox "Connecting..."
        'adStateExecuting
        Case 4
            MsgBox "Executing..."
        'adStateFetching
        Case 8
            MsgBox "Fetching..."
        Case Else
            MsgBox conServer.State
        End Select
End If

Set rstResult = Nothing

Exit Sub

SQL_ConnectionError:
MsgBox "Couldn't connect to the server. Please make sure that you have a working connection to the server."

Set OutApp = New Outlook.Application
Set OutMail = OutApp.CreateItem(0)
With OutMail
    .Subject = "Problems connecting to database '" & strDatabase & "' hosted on the server '" & strServer & "'"
    .HTMLBody = "<span style=""font-size:10px"">---Automatically generated Error-Email---" & _
            "</span><br><br>Error report from the file '" & _
            "<span style=""color:blue"">" & ThisWorkbook.Name & _
            "</span>' located and saved on '<span style=""color:blue"">" & _
            ThisWorkbook.Path & "</span>'.<br>" & _
            "Excel is not able to establish a connection to the server. Technical data to follow." & "<br><br>" & _
            "Computer Name:    <span style=""color:green;"">" & Environ("COMPUTERNAME") & "</span><br>" & _
            "Logged in as:     <span style=""color:green;"">" & Environ("USERDOMAIN") & "/" & Environ("USERNAME") & "</span><br>" & _
            "Domain Server:    <span style=""color:green;"">" & Environ("LOGONSERVER") & "</span><br>" & _
            "User DNS Domain:  <span style=""color:green;"">" & Environ("USERDNSDOMAIN") & "</span><br>" & _
            "Operating System: <span style=""color:green;"">" & Environ("OS") & "</span><br>" & _
            "Excel Version:    <span style=""color:green;"">" & Application.Version & "</span><br>" & _
            "<br><span style=""font-size:10px""><br>" & _
            "<br><br>---Automatically generated Error-Email---"
    .Display
End With
Set OutMail = Nothing
Set OutApp = Nothing

Exit Sub

SQL_StatementError:
MsgBox "There seems to be a problem with the SQL Syntax in the programming."

Set OutApp = New Outlook.Application
Set OutMail = OutApp.CreateItem(0)
With OutMail
    .Subject = "Problems with the SQL Syntax in file '" & ThisWorkbook.Name & "'."
    .HTMLBody = "<span style=""font-size:10px"">" & _
            "---Automatically generated Error-Email---" & _
            "</span><br><br>" & _
            "Error report from the file '" & _
            "<span style=""color:blue"">" & _
            ActiveWorkbook.Name & _
            "</span>" & _
            "' located and saved on '" & _
            "<span style=""color:blue"">" & _
            ActiveWorkbook.Path & _
            "</span>" & _
            "'.<br>" & _
            "It seems that there is a problem with the SQL-Code within trying to upload an extract to the server." & _
            "SQL-Code causing the problems:" & _
            "<br><br><span style=""color:green;"">" & _
            strSQL & _
            "</span><br><br><span style=""font-size:10px"">" & _
            "---Automatically generated Error-Email---"
    .Display
End With
Set OutMail = Nothing
Set OutApp = Nothing

Exit Sub

End Sub

Note, that the above code clearly distinguishes between (first) connecting to the server and then (afterwards) issuing a query to the server to retrieve some data. Both steps are separated and there is a different error handler for either case.

Furthermore, the above sample code also results in an empty recordset being returned. But the code is able to handle that incident with yet another error handler.

If the connection fails or if the SQL syntax being sent to the server contains error(s) then the above code will automatically generate an error email (using Outlook) with some details for you to check the connection and the SQL syntax.