Excel VBA

css navigation by Css3Menu.com

Open Connection ODBC

I had to stretch a little on this one. Everywhere I contract, the connection strings have their own special nyances.

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

We were originally pulling back 990,156 rows of data. VERY big error someplace. Now it is more like 75,000 rows.

© 2015-2017

Updated:  04/06/2017 20:31
This page added:  14 June 2015