Consulting

Results 1 to 3 of 3

Thread: VBA import certain content control forms from word into excel.

Threaded View

Previous Post Previous Post   Next Post Next Post
  1. #1
    VBAX Newbie
    Joined
    Apr 2021
    Posts
    2
    Location

    VBA import certain content control forms from word into excel.

    Hi Guys,

    I hope you're doing well.
    I'm fairly new to visual basic, and I've been trying to set up a form that can be completed in Word, and I want to be able to export some of the values in the fields over to Excel, but not all.

    I've attached a small example of the form.Laser Registration Form_test.docx

    So far, I've mostly 'borrowed' code found on the internet and adapted it slightly, so currently it will import all the answers to all of the word documents in a folder, and it will populate the spreadsheet from the top down.

    So, looking at the form I've uploaded, for example, how would I modify this to only import, say Laser Model and Laser Power, and then ignore the rest of the fields?
    Currently, I've just been tempted to import it all, and then post-process it with another script to delete the unwanted fields, but this is quite cumbersome.

    Current code is below.

    Sub GetFormData()
    'Note: this code requires a reference to the Word object model
    'To do this, go to Tools|References in the VBE, then scroll down to the Microsoft Word entry and check it.
    Application.ScreenUpdating = False
    Dim wdApp As New Word.Application, wdDoc As Word.Document, CCtrl As Word.ContentControl
    Dim strFolder As String, strFile As String, WkSht As Worksheet, i As Long, j As Long
    strFolder = GetFolder
    If strFolder = "" Then Exit Sub
    Set WkSht = ActiveSheet
    Dim Target As Integer
    Target = Sheet4.Range("F3").Value
    i = Sheet5.Range("Word_Start").Offset(Target, 0).Row
    strFile = Dir(strFolder & "\*.docx", vbNormal)
    While strFile <> ""
      i = i + 1
      Set wdDoc = wdApp.Documents.Open(Filename:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
      With wdDoc
        j = 0
        For Each CCtrl In .ContentControls
          With CCtrl
            Select Case .Type
              Case Is = wdContentControlCheckBox
               j = j + 1
               WkSht.Cells(i, j).Value = .Checked
              Case wdContentControlDate, wdContentControlDropdownList, wdContentControlRichText, wdContentControlText
               j = j + 1
               WkSht.Cells(i, j).Value = .Range.Text
              Case Else
            End Select
          End With
        Next
        .Close SaveChanges:=False
      End With
      strFile = Dir()
    Wend
    wdApp.Quit
    Set wdDoc = Nothing: Set wdApp = Nothing: Set WkSht = Nothing
    Application.ScreenUpdating = True
    End Sub
    
    
    Function GetFolder() As String
    Dim oFolder As Object
    GetFolder = ""
    Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
    If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
    Set oFolder = Nothing
    End Function
    Any help at all would be appreciated, so thank you for your time!
    Last edited by macropod; 07-11-2022 at 02:37 PM.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •