Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 1516
  • Last Modified:

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 ?

Thanks
0
AXISHK
Asked:
AXISHK
  • 7
  • 6
1 Solution
 
borgunitCommented:
http://www.connectionstrings.com/


This site might help
0
 
ScriptAddictCommented:
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
     oQuery.Refresh
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 _
("C:\Integration\IntegrationDatabase.accdb")
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
Sheets("Main").Select
ActiveSheet.Range("A6:K10000").ClearContents

'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

0
 
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

0
Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

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

http://www.progresstalk.com/showthread.php?118661-Excel-ActiveX-ADO-2.8-and-Open-Edge-10.2B-driver-problem
0
 
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 ?


0
 
ScriptAddictCommented:
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.

0
 
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 ?

Tks
0
 
ScriptAddictCommented:
Please post Excel Version and Code.  I'm just guessing without more information.
0
 
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
0
 
ScriptAddictCommented:
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
Usage
ManufacturerProgress Software

Standard
Include only the parameters you want to override from the system DSN settings
DSN=myDSN;HOST=myServerAddress;DB=myDataBase;UID=myUsername;PWD=myPassword;PORT=2055;

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

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

Tks
0
 
ScriptAddictCommented:
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
Worksheets("TimeRecords").Activate
Worksheets("TimeRecords").Cells.Select
Worksheets("TimeRecords").Cells.Delete
Worksheets("TimeRecords").Cells.ClearContents

'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
xNazwa.Delete
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;"), _
        Destination:=Worksheets("TimeRecords").Range("$A$1")).QueryTable
            .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
Else
     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

Endsub:
'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()
        Loop
        ' Return the array of found files.
        GetAllFilesInDir = varFiles
    End If
GetAllFiles_End:
    Exit Function
GetAllFiles_Err:
    GetAllFilesInDir = False
    Resume GetAllFiles_End
End Function

Open in new window



Hope that helps if your still working on this.
0
 
AXISHKAuthor Commented:
Tks
0

Featured Post

What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

  • 7
  • 6
Tackle projects and never again get stuck behind a technical roadblock.
Join Now