Как я могу использовать VBA для экспорта данных из формы MS Access в MS Word раскрывающегося управления контентом - PullRequest
Новая
       90

Как я могу использовать VBA для экспорта данных из формы MS Access в MS Word раскрывающегося управления контентом

0 голосов
/ 08 января 2020

Я использую vba в форме MS Access для вставки данных из Access в элементы управления содержимым MS Word. Код работает для текстовых полей, полей даты и полей флажков. Но у меня возникают проблемы при вставке данных в раскрывающееся поле. В свойствах моего раскрывающегося списка в MS Word используются «отображаемое имя» и значение для хранения данных (например, «Отображаемое имя = Adirondack и Значение = 1», «Отображаемое имя = Буффало и Значение = 2)». Вот код, который работает вместе с сообщением об ошибке, которое возникает при попытке вставить в раскрывающийся список. Ваша помощь будет высоко ценится! 

Private Sub Command179_Click()
' subroutine for exporting referral data from MS Access table to MS Word form content controls
Dim CC As ContentControl
Dim objLE As ContentControlListEntry
Dim fc As Field
Dim ccInfo As String
Dim Female As String

Dim appWord As Word.Application
Dim doc As Word.Document
Dim strDocName As String
Dim blnQuitWord As Boolean

On Error GoTo ErrorHandling

strPath = "C:\Users\AlbanyHiker\Documents\Custom Office Templates\INTAKE FORM\INTAKE BLANK FORM.docm"
strDocName = strPath
Set appWord = GetObject(, "Word.Application")
appWord.Visible = True

Set doc = appWord.Documents.Open(strDocName)

 If IsNull(Me!ref_referral_dt) Then
    MsgBox "REFERRAL DATE IS MISSING, COMPLETE FORM BEFORE EXPORT"
    Me!ref_referral_dt = #1/1/9999#
    End If

For Each CC In doc.ContentControls
        ccInfo = "<> ID= " & CC.ID & " Title = " & CC.Title & " tag = " & CC.Tag & " Text = " & CC.Range.Text & vbCrLf

        Debug.Print ccInfo
        Select Case CC.Tag:

            Case "frm_referral_dt"
                CC.Range.Text = Me!ref_referral_dt

            Case "frm_referral_number"
                CC.Range.Text = Me!ref_referral_number

            Case "frm_part_name_first"
                CC.Range.Text = Me!ref_part_name_first

            Case "frm_part_name_last"
                CC.Range.Text = Me!ref_part_name_last

            Case "frm_part_address1"
                CC.Range.Text = Me!ref_part_address1

            Case "frm_part_address2"
                CC.Range.Text = Me!ref_part_address2

            Case "frm_mailing_current"
                If Me!ref_mailing_current = "-1" Then CC.Checked = True

            Case "frm_part_city"
                CC.Range.Text = Me!ref_part_city

            Case "frm_part_zip"
                CC.Range.Text = Me!ref_part_zip

            Case "frm_part_telephone"
                CC.Range.Text = Me!ref_part_telephone

' Next case statement throws the following error message
' 6124: you are not allowed to edit this selection because it is protected
             Case "frm_part_region"
                CC.Range.Text = Me!ref_part_region

        End Select
Next

MsgBox "INTAKE Report Data Was Successfully Exported, Remember to Save the Word-Fillable File Using a Different Name"

Cleanup:
    'do something here to cleanup stuff
    Exit Sub

ErrorHandling:

Select Case Err.Number
Case -2147022986, 429
    Set appWord = CreateObject("Word.Application")
    blnQuitWord = True
    Resume Next

Case -2147352571
    MsgBox "There is a Type Mismatch Error indicating that a date may have been mistyped" _
    & " No data imported.  PLEASE CHECK DATA ENTRY ON ALL DATES ", vbOKOnly, _
    " Please check the date entries on the form"


 Case 5121, 5174
    MsgBox "You must select a valid Word Document. " _
    & " No data was imported.", vbOKOnly, _
    " Document Not Found"

Case 5491
    MsgBox "The document you selected does not" _
    & " contain the required form fields." _
    & " No data exported.", vbOKOnly, _
    " Fields Not Found"

Case Else
    MsgBox Err & ": " & Err.Description

End Select
GoTo Cleanup

ExitSubError:
    Set rs = Nothing
    '..and set it to nothing
    MsgBox "Export failed, correct problems and export again"
    Exit Sub
End Sub
...