Scan all existing listBoxes in a document and retrieve the selected value.

[Wire.Lless]

Hello.


I have a number of MS Word documents that all have the same layout.
I wish:
1- open each document

2- browse through all the listboxes in each document

3-For each listbox:

I want to retrieve the value that is selected

For the moment I have managed to program the first part: Loop on several Word documents:

Public wordApp As New Word.Application
Public Sub Ouvrir_Tout_Les_Fichiers()
Dim Fichier_Objet As String
 
titre = "Ouvrir le(s) fichier(s)"
Filt = "Fichier(s) a integrer (*.docm;*.doc;*.docx),*.docm;*.doc;*.docx"
fileToOpen = Application.GetOpenFilename(FileFilter:=Filt, Title:=titre, MultiSelect:=True)
 
For I = LBound(fileToOpen) To UBound(fileToOpen)
 
    FilePath = Left(fileToOpen(I), InStrRev(fileToOpen(I), "\"))
    Fichier_Objet = Mid(fileToOpen(I), InStrRev(fileToOpen(I), "\") + 1)
    Set wordApp = CreateObject("Word.Application")
    wordApp.Documents.Open fileToOpen(I)
    wordApp.Visible = True
 
    File_Name = UBound(fileToOpen)
 
    Call _2browse_through_all_the_listboxes_in_each_document(I, Fichier_Objet)
 
    wordApp.Documents.Close
    wordApp.Quit
 
Next I
 
End Sub

In each document I try to browse all the listboxes!

Apparently the listboxes are "ContentControlListEntry" objects...
https://docs.microsoft.com/fr-fr/off...ntrollistentry

... which are contained in "ContentControl" objects

https://docs.microsoft.com/fr-fr/off...ntent-controls

Public Sub _2browse_through_all_the_listboxes_in_each_document(I, Fichier_Objet)
Dim objCc As ContentControl
Dim objLe As ContentControlListEntry
 
Debug.Print Fichier_Objet
 
For Each objCc In wordApp.ActiveDocument.ContentControls
   For Each objLe In objCc.DropdownListEntries
        Debug.Print objLe.Text
        Debug.Print objLe.Index
        Debug.Print objLe.Value
        'Debug.Print objLe.Creator
   Next
Next
 
End Sub

I try to browse all the listboxes (objCc.DropdownListEntries) and extract the value that has been selected. But it's impossible to find the right property!
I managed to extract objLe.Text; objLe.Index; objLe.Value ... but I can't find anything that looks like the value that was chosen in the list box. (maybe the visible property = true ... or something like that??)

...
I managed to successfully extract the values of the "checkboxes" and the values of the "user fields"... but I really block on these "listboxes":

Public Sub Extract_user_fields_and_checkbox(I, Fichier_Objet)
Dim ch As Field
Dim Ctrl As ContentControl
 
Debug.Print Fichier_Objet
 
For Each ch In wordApp.ActiveDocument.Fields
   If ch.Type = "70" Then
      Debug.Print "Index ", ch.Index
      Debug.Print "Result ", ch.Result
      Debug.Print "Type ", ch.Type
   End If
Next ch
 
For Each Ctrl In wordApp.ActiveDocument.ContentControls
   If Ctrl.Type = "8" Then
      If Ctrl.Checked = True Then
         Debug.Print Ctrl.Tag
         Debug.Print Ctrl.ID
         Debug.Print "True"
      Else
         Debug.Print Ctrl.Tag
         Debug.Print Ctrl.ID
         Debug.Print "False"
 
      End If
   End If
Next
End Sub

Does anyone have any idea how to proceed?
Thank you very much

[Wire.Lless]

Well, I don't think I'm that far from the solution because the following code can display the contents of my listbox!
(Then, I'm not sure I'm using the right vocabulary... but apparently they're ContentControlListEntry since I can display each item in my "list")

Public Sub _2_browse_through_all_the_listboxes_in_each_document(I, Fichier_Objet)
Dim objCc As ContentControl
Dim objLe As ContentControlListEntry
 
Debug.Print Fichier_Objet
 
For Each objCc In wordApp.ActiveDocument.ContentControls
   For Each objLe In objCc.DropdownListEntries
        Debug.Print objLe.Text
        Debug.Print objLe.Index
        Debug.Print objLe.Value
        'Debug.Print objLe.Creator
   Next
Next
 
End Sub

[macropod]

Perhaps:

Sub GetFormData()
'Note: this code requires a reference to the Word object model.
'See under the VBE's Tools|References.
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, r As Long, c As Long
strFolder = GetFolder
If strFolder = "" Then Exit Sub
Set WkSht = ActiveSheet: r = WkSht.Cells(WkSht.Rows.Count, 1).End(xlUp).Row
'Disable any auto macros in the documents being processed
wdApp.WordBasic.DisableAutoMacros
strFile = Dir(strFolder & "\*.doc", vbNormal)
While strFile <> ""
  r = r + 1
  Set wdDoc = wdApp.Documents.Open(Filename:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
  With wdDoc
    c = 1: WkSht.Cells(r, c) = Split(strFile, ".doc")(0)
    For Each CCtrl In .ContentControls
      With CCtrl
        Select Case .Type
          Case wdContentControlDropdownList, wdContentControlComboBox
            c = c + 1
            If IsNumeric(.Range.Text) Then
              If Len(.Range.Text) > 15 Then
                WkSht.Cells(r, c) = "'" & .Range.Text
              Else
                WkSht.Cells(r, c) = .Range.Text
              End If
            Else
              WkSht.Cells(r, c) = .Range.Text
            End If
          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