Excel VBA

Open Connection ODBC

I needed to get the UserID and Workstation ID before going for the data. I used Enum to define where the columns are because the data has changed several times.

Enum InvCols
    RunDate = 18
    DateStamp = 22	'Set column # of field
    PlantName = 20
    PartNumb = 1
End Enum


Sub OpenQueryPop()
'
' OpenQueryPop Macro
'
    Dim UserName    As String
    Dim daCurDate   As Date
    Dim RptDate     As String
    Dim CurMach     As String
    Dim I           As Long
    Dim LastCol     As Long
    Dim LastRowr    As Long
    Dim GetDate     As Long
    Dim cnPubs      As ADODB.Connection
    Dim rsPubs      As ADODB.Recordset
    Dim strConn     As String
    Dim SQLstr      As String
    
Be sure to set the ADO references in Tools
    Set cnPubs = New ADODB.Connection
    
    daCurDate = InputBox("Enter the date for which you want Inventory report", "Get Date", Application.Text(Now() - 1, "mm/dd/yyyy"))
    RptDate = Application.Text(daCurDate, "YYYY-MM-DD")
    CurMach = Environ("ComputerName")
    UserName = Environ("Username")
    ActiveWorkbook.Sheets("Inv").Select
    
    ActiveSheet.UsedRange.Clear
 
    'Use the SQL Server OLE DB Provider.
    strConn = "Trusted_Connection=Yes;Initial Catalog=CompanyWideMetrics;"
    
    strConn = strConn & "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=True;"
    'Connect to the Pubs database on the local server.
    strConn = strConn & "SERVER=dev-sql;"
    
    'Use an integrated login.
    strConn = strConn & " UID=" & UserName & ";Workstation ID=" & CurMach & ";"
    
    'Now open the connection.
    cnPubs.Open strConn     
    

    SQLstr = "SELECT * "
    SQLstr = SQLstr & " FROM CompanyWideMetrics.dbo.vwCombinedInventory vwCombinedInventory "
    SQLstr = SQLstr & " WHERE (vwCombinedInventory.RunDate>={ts '" & RptDate _
        & " 00:00:00.000'} And vwCombinedInventory.RunDate<{ts '" & RptDate & " 23:59:59.999'})"
    SQLstr = SQLstr & " ORDER BY vwCombinedInventory.PartNumber,vwCombinedInventory.PlantLocation;"

    Set rsPubs = New ADODB.Recordset
    With rsPubs
        ' Assign the Connection object.
        .ActiveConnection = cnPubs
        ' Extract the required records.
        .Open SQLstr
        ' Copy the records into cell A1 on Sheet1.
    For I = 0 To .Fields.Count - 1          'Thank you TEK-TIPS.com
        Sheets("Inv").Cells(1, I + 1) = .Fields(I).Name
    Next
      'GET Field names
        
        Sheets("Inv").Range("A2").CopyFromRecordset rsPubs

        ' Tidy up
        .Close
    End With
   LastRowr = Range(Cells(999990, InvCols.PartNumb).Address).End(xlUp).Row   'LAST ROW
   Range(Cells(2, InvCols.RunDate), Cells(LastRowr, InvCols.RunDate)).Select
    Selection.NumberFormat = "mm/dd/yyyy h:mm;@"
    Cells(1, InvCols.PartNumb).Select
    LastCol = Selection.End(xlToRight).Column    'LAST COLUM
    Columns(LastCol + 1).Select
    Range(Cells(1, InvCols.PartNumb), Cells(1, LastCol + 1)).Select
Selection.Font.bold = True
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 192
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    Range("A2").Select
    ActiveWindow.FreezePanes = True
    '----------------------
    cnPubs.Close
    Set rsPubs = Nothing
    Set cnPubs = Nothing
    ConvertTimeStampI InvCols.RunDate
   ' BuildDailyPivot
   MsgBox "Completed with " & LastRowr & " lines of data", vbInformation
End Sub