×
INTELLIGENT WORK FORUMS
FOR ENGINEERING PROFESSIONALS

Log In

Come Join Us!

Are you an
Engineering professional?
Join Eng-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!
  • Students Click Here

*Eng-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

Jobs

VBA Connect to ODBC Database

VBA Connect to ODBC Database

VBA Connect to ODBC Database

(OP)
Stupid question #100

I cannotfigure out how toactually connect to a ODBC database in VBA. I'm thinking I need to use the DBConnect function, but not sure about the Object it is requiring. Like the help file says use Object.Connect, but what exactly does it want? I can connect using the DBConnect Config tool manually, but not programmatically.

Can anybody help me with a sample Object setup and call?

RE: VBA Connect to ODBC Database

This is just copied out of a routine I now use but it may give some insight....

Private Sub GetDbConnection()
Dim AdoConn As New ADODB.Connection
Dim adoCmd As New ADODB.Command
Dim Errs1 As Errors
Dim Rs As New ADODB.Recordset
Dim i As Integer
Dim sDbConnect As String
Dim sDbFolder As String
Dim sDbName As String
' Error Handling Variables
Dim errLoop As Error
Dim strTmp As String
'''''''''''''''''''''''''''''''''''''''
'CODE HERE FOR DB COMPARISON!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Dim vntList As Variant
Dim strRootFolder As String
Dim strExt As String
''''Dim lstBox As ListBox
''''Dim vFoundFiles As Variant
Dim sQuery As String
Dim sAddRecord As String
'''''''''''''''''''''''''''''''''''''''
strRootFolder = "M:\Folder\Subfolder\"
''''strExt = "*.dwg"

''''Set lstBox = frmUser.List1
''''Call AddFilesToListBox(strRootFolder, strExt, lstBox)
'------------------------------------------------------------------------------
'Create array list of drawings that have been transferred
'------------------------------------------------------------------------------
''''vFoundFiles = CreateVariant(lstBox, strRootFolder)
''''vFoundFiles = RevParseDate(vFoundFiles) 'Set to ISO date code
''''Set lstBox = Nothing
'------------------------------------------------------------------------------
'Get database connection
'------------------------------------------------------------------------------
sDbFolder = "M:\Folder\Subfolder"
sDbName = "MATERIAL_TRANSLATION.mdb"
sDbConnect = "Driver={Microsoft Access Driver (*.mdb)};" & _
              "Dbq=" & sDbName & ";" & _
              "DefaultDir=" & sDbFolder & ";Uid=Admin;Pwd=;"

'------------------------------------------------------------------------------
' Connection Object Methods
'------------------------------------------------------------------------------
On Error GoTo AdoError  ' Full Error Handling which traverses
                        ' Connection object

' Connection Open method #1:  Open via ConnectionString Property
AdoConn.ConnectionString = sDbConnect
AdoConn.Open
AdoConn.Close
AdoConn.ConnectionString = ""

'''' Connection Open method #2:  Open("[ODBC Connect String]","","")
'''adoConn.Open sDbConnect
'''adoConn.Close
'''
'''' Connection Open method #3:  Open("DSN","Uid","Pwd")
'''adoConn.Open "Driver={Microsoft Access Driver (*.mdb)};" & _
'''           "DBQ=WPS_Uploads.mdb;" & _
'''           "DefaultDir=M:\Folder;" & _
'''           "Uid=Admin;Pwd=;"
'''adoConn.Close

'------------------------------------------------------------------------------
' Recordset Object Methods
'------------------------------------------------------------------------------
' Don't assume that we have a connection object.
On Error GoTo AdoErrorLite

' Recordset Open Method #1:  Open via Connection.Execute(...)
'adoConn.Open sDbConnect
''''Set Rs = adoConn.Execute("SELECT * FROM Uploads")

'''' Recordset Open Method #2:  Open via Command.Execute(...)
AdoConn.ConnectionString = sDbConnect
AdoConn.Open
'''adoCmd.ActiveConnection = adoConn
'''adoCmd.CommandText = "SELECT * FROM Uploads"
'''Set Rs = adoCmd.Execute
'''Rs.Close
'''adoConn.Close
'''adoConn.ConnectionString = ""
'''
'''' Recordset Open Method #3:  Open w/o Connection & w/Connect String
'''Rs.Open "SELECT * FROM Uploads", sDbConnect, adOpenForwardOnly
'''Rs.Close

'------------------------------------------------------------------------------
'Cycle through found dwg array and look for match in db, if no match add to db
'------------------------------------------------------------------------------
Dim sDate As String
Dim sType As String
Dim sJob As String
Dim sFile As String

For i = 0 To UBound(vFoundFiles)
    sDate = vFoundFiles(i)(0)
    sType = vFoundFiles(i)(1)
    sJob = vFoundFiles(i)(2)
    sFile = vFoundFiles(i)(3)

    sQuery = "SELECT * FROM Uploads WHERE Date='" & sDate & _
                                   "' AND Type='" & sType & _
                                   "' AND Job='" & sJob & _
                                   "' AND File='" & sFile & "'"

    Set Rs = AdoConn.Execute(sQuery)
    If Rs.EOF Or Rs.BOF Then
        'MsgBox "No results found..."
        sAddRecord = "INSERT INTO Uploads ([Date],[Type],[Job],[File]) VALUES ('" & _
                        sDate & "','" & _
                        sType & "','" & _
                        sJob & "','" & _
                        sFile & "')"
        AdoConn.Execute (sAddRecord)

    End If

Next i

Rs.Close
AdoConn.Close

Done:
    Set Rs = Nothing
    Set adoCmd = Nothing
    Set AdoConn = Nothing
    
    Exit Sub
AdoError:
    i = 1
    On Error Resume Next
    ' Enumerate Errors collection and display properties of
    ' each Error object (if Errors Collection is filled out)
    Set Errs1 = AdoConn.Errors
    For Each errLoop In Errs1
        With errLoop
            strTmp = strTmp & vbCrLf & "ADO Error # " & i & ":"
            strTmp = strTmp & vbCrLf & "   ADO Error   # " & .Number
            strTmp = strTmp & vbCrLf & "   Description   " & .Description
            strTmp = strTmp & vbCrLf & "   Source        " & .Source
            i = i + 1
        End With
    Next

AdoErrorLite:
    ' Get VB Error Object's information
    strTmp = strTmp & vbCrLf & "VB Error # " & Str(Err.Number)
    strTmp = strTmp & vbCrLf & "   Generated by " & Err.Source
    strTmp = strTmp & vbCrLf & "   Description  " & Err.Description

    MsgBox strTmp

    ' Clean up gracefully without risking infinite loop in error handler
    On Error GoTo 0
    GoTo Done
End Sub

"Everybody is ignorant, only on different subjects." — Will Rogers

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Eng-Tips Forums free from inappropriate posts.
The Eng-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Eng-Tips forums is a member-only feature.

Click Here to join Eng-Tips and talk with other members!


Resources