Consulting

Results 1 to 2 of 2

Thread: Extracting Paired Data from Word to Excel

  1. #1

    Question Extracting Paired Data from Word to Excel

    Thank you everyone for posting this code (http://www.vbaexpress.com/forum/show...el-spreadsheet) and alterations. It is very helpful. I have a word doc that has the user enter a keyword and a date, type information, then jump to the next page and repeat the process for a total of 10 times. Is there additional code to organize it so that each keyword and date appears on their own line in Excel rather than taking up 20 columns?

    Thank you!
    Last edited by macropod; 04-05-2019 at 08:32 PM.

  2. #2
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,435
    Location
    Try:
    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, 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
    strFile = Dir(strFolder & "\*.docx", vbNormal)
    While strFile <> ""
      Set wdDoc = wdApp.Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
      With wdDoc
        c = 0
        For Each CCtrl In .ContentControls
          c = c Mod 2 + 1
          If c = 1 Then r = r + 1
          WkSht.Cells(r, c).Value = CCtrl.Range.Text
        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
    Last edited by macropod; 07-11-2022 at 02:37 PM.
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

Posting Permissions

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