VBA Connect to ODBC Database

[CanonShooter]

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?

 

[borgunit]

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