View Single Post
 
Old 04-10-2016, 08:29 AM
highrise955 highrise955 is offline Windows 10 Office 2013
Advanced Beginner
 
Join Date: Mar 2016
Posts: 37
highrise955 is on a distinguished road
Default

Quote:
Originally Posted by gmayor View Post
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):

Reply With Quote