Quote:
Originally Posted by gmayor
|
Graham (or anyone else),
I need some assistance on how I would modify the following code so I could use an Access (Access 2016) database as my data source to populate content controls. Any information, be it code or links, will be appreciated.
Code:
Sub Main()
Dim oFrm As New DrawingNumberEntryForm 'userform to retrieve initial drawing number
With oFrm
xlFillList ListOrComboBox:=.DrawingNumberUf, _
iColumn:=1, _
strWorkbook:="C:\Temp\ItemSheet2.xlsx", _
strRange:="TableXXX", _
RangeIsWorksheet:=False, _
RangeIncludesHeaderRow:=True
.Show
If .Tag = 0 Then GoTo lbl_Exit 'Cancel was selected
'ActiveDocument.SelectContentControlsByTitle("Drawing Number").Item(1).Range.Text = .DrawingNumberUf.Text
If .DrawingNumberUf.Column(3) = "N" Then
ActiveDocument.Unprotect '("PreciseTF")
ActiveDocument.Tables(2).Delete
ActiveDocument.SelectContentControlsByTitle("Cert Type").Item(1).Range.Text = .DrawingNumberUf.Column(4)
ActiveDocument.Protect NoReset:=True, Password:="", Type:=wdAllowOnlyFormFields
End If
ActiveDocument.SelectContentControlsByTitle("Drawing Number").Item(1).Range.Text = .DrawingNumberUf.Column(0)
ActiveDocument.SelectContentControlsByTitle("Revision").Item(1).Range.Text = .DrawingNumberUf.Column(1)
ActiveDocument.SelectContentControlsByTitle("Part Description").Item(1).Range.Text = .DrawingNumberUf.Column(2)
End With
lbl_Exit:
Unload oFrm
Set oFrm = Nothing
Exit Sub
End Sub
--------------------------------------------------------------------------------
Private Function xlFillList(ListOrComboBox As Object, _
iColumn As Long, _
strWorkbook As String, _
strRange As String, _
RangeIsWorksheet As Boolean, _
RangeIncludesHeaderRow As Boolean)
If RangeIsWorksheet = True Then
strRange = strRange & "$]"
Else
strRange = strRange & "]"
End If
Set CN = CreateObject("ADODB.Connection")
If RangeIncludesHeaderRow Then
CN.Open ConnectionString:="Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & strWorkbook & ";" & _
"Extended Properties=""Excel 12.0 Xml;HDR=YES"";"
Else
CN.Open ConnectionString:="Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & strWorkbook & ";" & _
"Extended Properties=""Excel 12.0 Xml;HDR=NO"";"
End If
Set RS = CreateObject("ADODB.Recordset")
RS.CursorLocation = 3
RS.Open "SELECT * FROM [" & strRange, CN, 2, 1 'read the data from the worksheet
With RS
.MoveLast
numrecs = .RecordCount
.MoveFirst
End With
With ListOrComboBox
.ColumnCount = RS.Fields.Count
If RS.RecordCount > 0 Then
.Column = RS.GetRows(numrecs)
End If
strWidth = vbNullString
For q = 1 To .ColumnCount
If q = iColumn Then
If strWidth = vbNullString Then
strWidth = .Width - 4 & " pt"
Else
strWidth = strWidth & .Width - 4 & " pt"
End If
Else
strWidth = strWidth & "0 pt"
End If
If q < .ColumnCount Then
strWidth = strWidth & ";"
End If
Next q
.ColumnWidths = strWidth
End With
'Cleanup
If RS.State = 1 Then RS.Close
Set RS = Nothing
If CN.State = 1 Then CN.Close
Set CN = Nothing
lbl_Exit:
Exit Function
End Function
Here is my table (DrawingNumberTable) in my Access database (DrawingNumberdB):