Import Word Form Fields into excel

[TiffanyW]

I have the following Macro that imports form fields from word into Excel taken from a previously closed post. When it exports it always puts the data on the next row in excel, instead I want it to always override the previous data and put the new data in row 2 after my headers. I have played around and can't seem to figure out how to accomplish this.

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, FmFld As Word.FormField
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
i = WkSht.Cells(WkSht.Rows.Count, 1).End(xlUp).Row
strFile = Dir(strFolder & "\*.doc", 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
    For Each FmFld In ActiveDocument.FormFields
      j = j + 1
      With FmFld
        Select Case .Type
          Case Is = wdFieldFormCheckBox
           WkSht.Cells(i, j).Value = .Checked
          Case Else
           WkSht.Cells(i, j).Value = .Result
          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

[macropod]

So how would the macro determine what's old and what's new?

PS: When posting code, please use the code tags, indicated by the# button on the posting menu. Without them, your code has lost whateverstructure it had.

[gmayor]

If you want to replace everything in the sheet with the data then make the following changes. Note that as you are working with content controls also, ensure that the macro can only process xml documents or you will have to add error correction. It might be simpler just to change doc to docx as shown

Set WkSht = ActiveSheet
WkSht.Rows("2:" & Rows.Count).ClearContents
i = 1
strFile = Dir(strFolder & "\*.docx", vbNormal)

[TiffanyW]

This is exactly what I am looking for. I need to Clear the contents in Row 2 then import the new form fields into row 2. I have tried this code and now I am getting the error "1004:Application-defined or object-defined error". I have tried playing around with it but nothing seems to work.

[gmayor]

My guess is that you have not set a reference to the Word object library. The following doesn't need such a reference and does work, albeit with reservations about the fact that there is no error handling whatsoever to ensure that the documents processed all match, or that they even contain content controls or form fields. If there happens to be a document in the folder that doesn't match the parameters it is likely to crash. I would also caution against checking form fields and content controls in the same process. The two are not really compatible with one another. I have also replaced the getfolder function as it is a pain to navigate with a large folder structure.

Option Explicit

Sub GetFormData()
'Note: this code DOES NOT require a reference to the Word object model
Dim wdApp As Object
Dim wdDoc As Object
Dim CCtrl As Object
Dim FmFld As Object
Dim strFolder As String, strFile As String
Dim WkSht As Worksheet, i As Long, j As Long

    Application.ScreenUpdating = False

    strFolder = BrowseForFolder("Select folder containing the form documents")
    If strFolder = "" Then Exit Sub
    Set WkSht = ActiveSheet
    WkSht.Rows("2:" & Rows.Count).ClearContents
    i = 1
    strFile = Dir(strFolder & "\*.docx", vbNormal)

    On Error Resume Next
    Set wdApp = GetObject(, "Word.Application")
    If Err Then
        Set wdApp = CreateObject("Word.Application")
    End If
    On Error GoTo 0

    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
                j = j + 1
                WkSht.Cells(i, j) = CCtrl.Range.Text
            Next
            For Each FmFld In .FormFields
                j = j + 1
                WkSht.Cells(i, j) = FmFld.Result
            Next
        End With
        wdDoc.Close 0
        strFile = Dir()
        DoEvents
    Wend
    wdApp.Quit
    Set wdDoc = Nothing: Set wdApp = Nothing: Set WkSht = Nothing
    Application.ScreenUpdating = True
End Sub

Private Function BrowseForFolder(Optional strTitle As String) As String
'Graham Mayor
'strTitle is the title of the dialog box
Dim fDialog As FileDialog
    On Error GoTo err_Handler
    Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
    With fDialog
        .Title = strTitle
        .AllowMultiSelect = False
        .InitialView = msoFileDialogViewList
        If .Show <> -1 Then GoTo err_Handler:
        BrowseForFolder = fDialog.SelectedItems.Item(1) & Chr(92)
    End With
lbl_Exit:
    Exit Function
err_Handler:
    BrowseForFolder = vbNullString
    Resume lbl_Exit
End Function