VBA use iproperty part number to search an Access database recordset

- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Hi all,
I am a beginner with VBA coding, and am getting caught up with a code I'm working on. I got the connection coding from this blog to help connect to the database. The MS Access database I need to read has a primary key column populated with alphanumeric values. These values are the same as my inventor "part number" (minus the file extension, .ipt). The other columns within this table hold different part properties such as description. When coding in Inventor VBA, I have connected to the access database table that holds the info I need to read. After creating a new recordset, I need to find a row within the recordset/or table that has the primary key value set to the part number of the file I have open. Can anyone help with recommending a line of code to perform this find? The goal is to have this work for any file I open, so possibly autopopulating the code with the iproperties "part number" property would be great. I am using MS Access 2010 and Inventor 2012 with reference set to Microsoft ActiveX Data Objects 6.1 Library in both Inventor and Access.
Below is the code I've tried without success:
Private Sub ImportfromAccess()
Dim sProvider As String
Dim sUser As String
Dim sPassword As String
sProvider = "Microsoft.ACE.OLEDB.12.0"
sUser = "Admin"
sPassword = ""
'Create a connection object
Dim cnDB As ADODB.Connection
Set cnDB = New ADODB.Connection
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
'Provide the connection string
Dim strConn As String
'Use the Access OLEDB Provider
strConn = strConn & "PROVIDER=" & sProvider & ";"
'Connect to the database on the server
strConn = strConn & "DATA SOURCE=C:\users\candace_g\documents\qtstestbom.mdb" & ";"
'Set user and password
strConn = strConn & "User Id=" & sUser & ";" & "Password=" & sPassword & ";"
'Open the connection
On Error Resume Next
cnDB.Open strConn
If Err Then
MsgBox (Err.Description)
MsgBox (Err.Number)
MsgBox (Err.Source)
Err.Clear
Return
End If
On Error GoTo 0
'GET THE ACTIVE DOCUMENT
Dim invDoc As Document
Set invDoc = ThisApplication.ActiveDocument
'GET THE (DESIGN TRACKING PROPERTIES) PROPERTY SET
Dim invDesignInfo As PropertySet
Set invDesignInfo = invDoc.PropertySets.Item("Design Tracking Properties")
'GET THE PART NUMBER PROPERTY
Dim invPartNumberProperty As Property
Set invPartNumberProperty = invDesignInfo.Item("Part Number")
'Open Table to Search
rs.Open Source:="PART", ActiveConnection:=cnDB, CursorType:=adOpenDynamic, LockType:=adLockOptimistic, Options:=adCmdTableDirect
(***THIS IS THE LINE OF CODE THAT PRODUCES ERROR***)
'Find item in Access Part Number column with KeyValue
rs.Find "[PART NUMBER] = invPartNumberProperty.Value", 0, adSearchForward, 1
If rs.EOF Then
MsgBox "The Recordset is empty."
End If
'GET AND SET THE iPROPERTIES DESCRIPTION
Dim invDescriptionProperty As Property
Set invDescriptionProperty = invDesignInfo.Item("Description")
invDescriptionProperty.Value = rs.Fields("Part Name").Value
rs.Close
cnDB.Close
Set rs = Nothing
Set cnDB = Nothing
End Sub
Any help would be appreciated.
Thanks,
Candace