Excel VB code for ODBC Connection

Currently, I used 3rd party ODBC created on the computer to a Progress Database and write query to retrieve some data through the Microsoft Excel Query.

Is it possible to put this connection into VB code such that I could pass the query string as parameter to the macro ? Is there any sample coding to illustrate that ?

Who is Participating?
ScriptAddictConnect With a Mentor Commented:
I use this to make my own odbc connection:

Private Sub CommandButton1_Click()
'Prevent alerts from displaying to users
Application.DisplayAlerts = False
'turns off screen updating for speed gains
Application.ScreenUpdating = False

'Declare variables
Dim FileList()
Dim x As Object
Dim path As String
Dim cntn As ListObject
Dim file1 As Variant

path = "\\Server\"

'Clear old data

'Clear out the old connections
Dim Sh As Worksheet, xNazwa As Object
Dim xConect As Object

For Each xConect In ActiveWorkbook.connections
If UCase(xConect.Name) Like "*" Then xConect.Delete
Next xConect

For Each Sh In ActiveWorkbook.Worksheets
For Each xNazwa In Sh.Names
Next xNazwa
Next Sh

FileList = GetAllFilesInDir(path)
For Each file In FileList
    'Connect via ODBC
   file0 = Left(file, Len(file) - 4)
   file1 = "SELECT * FROM ""PRT_" & file0 & "__TIME"""

If Workbooks("Payroll Dashboard.xlsm").connections.Count = 0 Then
    With Worksheets("TimeRecords").ListObjects.Add( _
    SourceType:=0, _
    Source:=Array( _
        "ODBC;" & _
        "DSN=Timberline Data Source;" & _
        "UID=UserID;" & _
        "PWD=Password;" & _
        "DBQ=\\Server\;" & _
        "CODEPAGE=1252;" & _
        "DictionaryMode=0;" & _
        "StandardMode=1;" & _
        "MaxColSupport=1536;" & _
        "ShortenNames=0;" & _
        "DatabaseType=1;"), _
            .CommandText = Array(file1)
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .BackgroundQuery = True
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .PreserveColumnInfo = True
            .ListObject.DisplayName = "Data"
            'Application.Wait (Now + TimeValue("00:00:10"))
            .Refresh BackgroundQuery:=True
        End With
     With Workbooks("Payroll Dashboard.xlsm").connections("Connection").ODBCConnection
        .CommandText = Array(file1)
     End With
    Workbooks("Payroll Dashboard.xlsm").Worksheets("TimeRecords").ListObjects("Data").QueryTable.Refresh BackgroundQuery:=False

End If
    Next file

Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "Updated Completed Without Any Errors"
Exit Sub

'Turns back on User Alerts and Screen Updates
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "Update Completed With Errors Check Sites to Make Sure The Base URL is Correct"

End Sub

Function GetAllFilesInDir(ByVal strDirPath As String) As Variant
    ' Loop through the directory specified in strDirPath and save each
    ' file name in an array, then return that array to the calling
    ' procedure.
    ' Return False if strDirPath is not a valid directory.
    Dim strTempName As String
    Dim varFiles() As Variant
    Dim lngFileCount As Long
    On Error GoTo GetAllFiles_Err
    ' Make sure that strDirPath ends with a "\" character.
     If Right$(strDirPath, 1) <> "\" Then
          strDirPath = strDirPath & "\"
    End If
    ' Make sure strDirPath is a directory.
    If GetAttr(strDirPath) And vbDirectory = vbDirectory Then
        strTempName = Dir(strDirPath, vbDirectory)
        Do Until Len(strTempName) = 0
            ' Exclude ".", "..".
            If (strTempName <> ".") And (strTempName <> "..") Then
                ' Make sure we do not have a sub-directory name.
                If (GetAttr(strDirPath & strTempName) _
                    And vbDirectory) <> vbDirectory Then
                    ' Increase the size of the array
                    ' to accommodate the found filename
                    ' and add the filename to the array.
                If Right(strTempName, 4) = ".prt" And LCase(Right(Left(strTempName, 9), 8)) <> "-current" And LCase(Right(Left(strTempName, 9), 8)) <> "-history" Then
                        ReDim Preserve varFiles(lngFileCount)
                        varFiles(lngFileCount) = strTempName
                        lngFileCount = lngFileCount + 1
                End If
                End If
            End If
            ' Use the Dir function to find the next filename.
            strTempName = Dir()
        ' Return the array of found files.
        GetAllFilesInDir = varFiles
    End If
    Exit Function
    GetAllFilesInDir = False
    Resume GetAllFiles_End
End Function

Open in new window

Hope that helps if your still working on this.

This site might help
For 2003:

Sub CreateParam()
     Dim oQuery As QueryTable
     Dim oParam As Parameter
     Set oQuery = Sheet3.QueryTables(1)
     oQuery.CommandText = Replace(oQuery.CommandText, "='Berlin'", "=?")
     Set oParam = oQuery.Parameters.Add("CityParam")
     oParam.SetParam xlRange, Sheet3.Range("J1")
     oParam.RefreshOnChange = True
End Sub

Open in new window

For 2010:

Sub RunParameterQuery()

'Step 1: Declare your variables
Dim MyDatabase As DAO.Database
Dim MyQueryDef As DAO.QueryDef
Dim MyRecordset As DAO.Recordset
Dim i As Integer

'Step 2: Identify the database and query
Set MyDatabase = DBEngine.OpenDatabase _
Set MyQueryDef = MyDatabase.QueryDefs("MyParameterQuery")

'Step 3: Define the Parameters
With MyQueryDef
.Parameters("[Enter Segment]") = Range("D3").Value
.Parameters("[Enter Region]") = Range("D4").Value
End With

'Step 4: Open the query
Set MyRecordset = MyQueryDef.OpenRecordset

'Step 5: Clear previous contents

'Step 6: Copy the recordset to Excel
ActiveSheet.Range("A7").CopyFromRecordset MyRecordset

'Step 7: Add column heading names to the spreadsheet
For i = 1 To MyRecordset.Fields.Count
ActiveSheet.Cells(6, i).Value = MyRecordset.Fields(i - 1).Name
Next i

MsgBox "Your Query has been Run"

End Sub

Open in new window

Introducing Cloud Class® training courses

Tech changes fast. You can learn faster. That’s why we’re bringing professional training courses to Experts Exchange. With a subscription, you can access all the Cloud Class® courses to expand your education, prep for certifications, and get top-notch instructions.

AXISHKAuthor Commented:
Coding the following with error :
Automation error
Unspecified error
The code stops at the cnProgress.Open statement, guessing something with the string. For the 2nd suggestion, how to setup the IntegrationDatabase.accdb file. Is it a database or just a connection file ? The database locates on the other server. Tks

Dim sql As String
Dim rs As Recordset
Dim cnProgress As New Connection

cnProgress.Open "localhost=HKG-SQL03;PORT=9460;User ID=sysprogress;PWD=test;"
Set rs = New Recordset
sql = "SELET * from VENDOR"
rs.Open sql, cnProgress

AXISHKAuthor Commented:
I use"Progress OpenEdge 10.2A Driver" but I receive different message.

AXISHKAuthor Commented:
Modify the string with "cnProgress.Open "DSN=EpicorTest905;HOST=HKG-SQL03;PORT=9460;DB=mfgsys;UID=sysprogress;PWD='test'" could get rid of the problem. However, the Excel hang up and never retrieve any data.

Any idea ?

The code stops at the cnProgress.Open statement, guessing something with the string.

For the 2nd suggestion, how to setup the IntegrationDatabase.accdb file. Is it a database or just a connection file ?
This is the new file format for an access database.  In this example it was pulling data from the MS Access database.

AXISHKAuthor Commented:
seem like it is related DAO driver in Window 2003 that is not compatible with the Progress. Any idea how to fix it ?

Please post Excel Version and Code.  I'm just guessing without more information.
AXISHKAuthor Commented:
Here is the coding, it stop at cnProgress.Open , tks

Sub RtnData()

Dim sql As String
Dim rs As Recordset
Dim cnProgress As New Connection

cnProgress.Open "DSN=EpicorTest905;HOST=HKG-SQL03;PORT=9460;DB=mfgsys;UID=SYSPROGRESS;PWD='xxxxx' "

Set rs = New Recordset
sql = "SELET * from VENDOR"
rs.Open sql, cnProgress

End Sub
It looks like the connection your using is for this Software specific connection.  I've included a link as well as a copy of the documentation related to this connection type.  Please note that to use a DSN it must be setup as a DSN on your workstation.  If it isn't this won't work.  
I can't help more then this on this line.  If your database is not made by Progress Software please let me know.

Link to your Connection Type

Progress ODBC Driver
TypeODBC Driver
ManufacturerProgress Software

Include only the parameters you want to override from the system DSN settings

Open in new window

Alternative using long names
Include only the parameters you want to override from the system DSN settings
DataSourceName=myDSN;HostName=myServerAddress;Database=myDataBase;LogonID=myUsername; Password=myPassword;PortNumber=2055;

Open in new window

What version of ADO do you have now?
AXISHKAuthor Commented:
Microsoft ActiveX Data Objects 2.8 Library. I run Excel 2010 on Window 2003.

AXISHKAuthor Commented:
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.