SQL Query

[JoeExcelHelp]

Hello all,
I have a server address and an predefined SQL query
I'm trying to get find a VBA code that
Calls this query
Removes existing content in Sheet1
places the table in sheet1 starting in A1
Thank You

[HansV]

What kind of database? SQL Server, MySQL, Oracle, ...?

[JoeExcelHelp]

SQL Server

[HansV]

Use this as a starting point. Change the strings MyServerAddress, MyDatabase, MyUsername, MyPassword and MyView to the ones you need.

Code: Select all

Sub GetDataFromSQLServer()
    Dim wsh As Worksheet
    Dim strConnection As String
    Dim strSQL As String
    Dim cnn As Object
    Dim rst As Object
    Dim i As Long

    ' Set error handler
    On Error GoTo ErrHandler

    ' Reference to the worksheet
    Set wsh = Worksheets("Sheet1")
    wsh.Cells.ClearContents

    ' Create the connection string
    strConnection = "Provider=SQLOLEDB;" & _
        "Data Source=MyServerAddress;" & _
        "Initial Catalog=MyDatabaseName;" & _
        "User ID=MyUsername;" & _
        "Password=MyPassword;"

    ' Create the Connection and Recordset objects
    Set cnn = CreateObject(Class:="ADODB.Connection")
    Set rst = CreateObject(Class:="ADODB.Recordset")

    ' Open the connection and execute
    cnn.Open strConnection
    strSQL = "SELECT * FROM MyView"
    Set rst = cnn.Execute(strSQL)

    ' Check if we have data
    If Not rst.EOF Then
        ' Fill first row with field names
        For i = 1 To rst.Fields.Count
            Cells(1, i).Value = rst.Fields(i - 1).Name
        Next i
        ' Transfer result
        wsh.Range("A2").CopyFromRecordset rst
    Else
        MsgBox "No records returned!", vbCritical
    End If

ExitHandler:
    ' Clean up
    On Error Resume Next
    ' Close the recordset
    rst.Close
    Set rst = Nothing
    ' Close the connection
    cnn.Close
    Set cnn = Nothing
    Exit Sub

ErrHandler:
    MsgBox Err.Description, vbExclamation
    Resume ExitHandler
End Sub

[JoeExcelHelp]

Thanks Hans,

This may seem like a silly question but,
I'm currently using this code to populate a report from a table within a database (That I extract each week)
Instead of referencing this source sPath = "\\kewntfile01\sharedfile\Operations Planning\__Dashboards by RP\Airport Training_Class_Rosters\Airport_Class_Ro.xlsxster"
Could I just reference the database itself? If so How would i modify spath?

Code: Select all

Sub ImportOrientation()
Dim sPath As String
Dim sFile As String
Dim wbD As Workbook
Dim shD As Worksheet
Dim rgD As Range
Dim wbS As Workbook
Dim shS As Worksheet
Dim rgS As Range

    Application.ScreenUpdating = False
    
    sPath = "\\kewntfile01\sharedfile\Operations Planning\__Dashboards by RP\Airport Training_Class_Rosters\Airport_Class_Roster.xlsx"
    If sPath = "False" Then Exit Sub
    Set wbD = ThisWorkbook
    Set shD = wbD.Sheets("Orientation")
    Set rgD = Intersect(shD.Range("A4").CurrentRegion, shD.Range("A4").CurrentRegion.Offset(3, 1))
    Workbooks.Open sPath, UpdateLinks:=False
    Set wbS = ActiveWorkbook
    Set shS = wbS.Sheets(1)
    Set rgS = shS.Range("A1").CurrentRegion
    sFile = "'[" & Split(sPath, "\")(UBound(Split(sPath, "\"))) & "]" & shS.Name & "'!"
    rgD.FormulaR1C1 = _
        "=SUMIFS(" & sFile & "C16," & _
        sFile & "C5,""=""&R5C," & _
        sFile & "C6,""=""&R6C," & _
        sFile & "C8,""=""&RC1," & _
        sFile & "C2,""=""&R4C," & _
        sFile & "C1,""<>""&""""," & _
        sFile & "C4,""<>""&""BP"")"
    rgD.Value = rgD.Value
    wbS.Close False
    Application.ScreenUpdating = True
End Sub

[HansV]

No, you cannot refer directly to a SQL Server database as if it was a workbook.

[JoeExcelHelp]

Thank You

[JoeExcelHelp]

Thank You Hans,
I have the following query portion of the attached code that references 2 dates
is it possible to have these 2 dates reference (1st date in A1 and 2nd date in A2 both on sheet3)

strSQL = "EXEC rp_opadwh.[dbo].[sp_opa_DataInventory_Airports_Horizontal] '2016-07-01', '2016-08-01'"

Code: Select all

Sub GetDataFromSQLServer2()
    Dim wsh As Worksheet
    Dim strConnection As String
    Dim strSQL As String
    Dim cnn As Object
    Dim rst As Object
    Dim i As Long

    ' Set error handler
    On Error GoTo ErrHandler

    ' Reference to the worksheet
    Set wsh = Worksheets("Sheet1")
    wsh.Cells.ClearContents

    ' Create the connection string
        

    ' Create the Connection and Recordset objects
    Set cnn = CreateObject(Class:="ADODB.Connection")
    Set rst = CreateObject(Class:="ADODB.Recordset")

    ' Open the connection and execute
    cnn.Open strConnection
    strSQL = "EXEC rp_opadwh.[dbo].[sp_opa_DataInventory_Airport_Horizontal] '2016-07-01', '2016-08-01'"
    Set rst = cnn.Execute(strSQL)

    ' Check if we have data
    If Not rst.EOF Then
        ' Fill first row with field names
        For i = 1 To rst.Fields.Count
            Cells(1, i).Value = rst.Fields(i - 1).Name
        Next i
        ' Transfer result
        wsh.Range("A2").CopyFromRecordset rst
    Else
        MsgBox "No records returned!", vbCritical
    End If

ExitHandler:
    ' Clean up
    On Error Resume Next
    ' Close the recordset
    rst.Close
    Set rst = Nothing
    ' Close the connection
    cnn.Close
    Set cnn = Nothing
    Exit Sub

ErrHandler:
    MsgBox Err.Description, vbExclamation
    Resume ExitHandler
End Sub

[HansV]

Like this:

Code: Select all

    strSQL = "EXEC rp_opadwh.[dbo].[sp_opa_DataInventory_Airport_Horizontal] '" & _
        Format(Worksheets("Sheet3").Range("A1").Value, "yyyy-mm-dd") & "', '" & _
        Format(Worksheets("Sheet3").Range("A2").Value, "yyyy-mm-dd") & "'"

[JoeExcelHelp]

Hans I get "Could not find stored procedure"

[JoeExcelHelp]

never mind Hans I left out a charactor :)

[JoeExcelHelp]

Hi Hans,

This code runs great but I'm experiencing a strange thing
If I run the code and dont have the sheet selected it leaves out the field headers
If I select the sheet it includes the headers?.. help please :)

Code: Select all

Sub GetDataFromSQLServerSAP()
    Dim wsh As Worksheet
    Dim strConnection As String
    Dim strSQL As String
    Dim cnn As Object
    Dim rst As Object
    Dim i As Long

    ' Set error handler
    On Error GoTo ErrHandler

    ' Reference to the worksheet
    Set wsh = Worksheets("SAP")
    wsh.Cells.ClearContents

    ' Create the connection string
    strConnection =
        

    ' Create the Connection and Recordset objects
    Set cnn = CreateObject(Class:="ADODB.Connection")
    Set rst = CreateObject(Class:="ADODB.Recordset")

    ' Open the connection and execute
    cnn.Open strConnection
    'strSQL = "EXEC rp_opadwh.[dbo].[sp_opa_DataInventory_Airports_Horizontal] '2016-07-24', '2016-07-24'"
       strSQL = "EXEC rp_opadwh.[dbo].[sp_opa_DataInventory_Airports_Horizontal] '" & _
        Format(Worksheets("Date").Range("A1").Value, "yyyy-mm-dd") & "', '" & _
        Format(Worksheets("Date").Range("A2").Value, "yyyy-mm-dd") & "'"
    Set rst = cnn.Execute(strSQL)

    ' Check if we have data
    If Not rst.EOF Then
        ' Fill first row with field names
        For i = 1 To rst.Fields.Count
            Cells(1, i).Value = rst.Fields(i - 1).Name
        Next i
        ' Transfer result
        wsh.Range("A2").CopyFromRecordset rst
    Else
        MsgBox "No records returned!", vbCritical
    End If

ExitHandler:
    ' Clean up
    On Error Resume Next
    ' Close the recordset
    rst.Close
    Set rst = Nothing
    ' Close the connection
    cnn.Close
    Set cnn = Nothing
    Exit Sub

ErrHandler:
    MsgBox Err.Description, vbExclamation
    Resume ExitHandler
End Sub

[HansV]

If you change the line

Code: Select all

            Cells(1, i).Value = rst.Fields(i - 1).Name

to

Code: Select all

            wsh.Cells(1, i).Value = rst.Fields(i - 1).Name

the headers will be placed in the same sheet as the data.

[JoeExcelHelp]

Thank You Hans.. you guys are ridiculously talented