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