I have a macro that reads data from the content controls in every Word file (strFile) in a folder (FormPath) into rows in the worksheet, including inserting the Word file name in column A.
Instead of reading every Word file every time, I would like the macro to read data only from those Word files not already processed (i.e. if the filename is in column A, then ignore that file).
I have made various attempts without success, as illustrated by the commented-out code.
Help gratefully received!
Sub AA_GetFormData2()
Application.ScreenUpdating = False
Dim wdApp As New Word.Application, wdDoc As Word.Document
Dim FmFld As Word.FormField, CCtrl As Word.ContentControl
Dim FormPath As String, strFile As String
Dim WkSht As Worksheet, c As Long, r As Long
Dim rngCopied As Range
Dim fname As Range
FormPath = "N:\...\ReceivedFiles\"
Set WkSht = ActiveSheet
r = WkSht.Cells(WkSht.Rows.Count, 1).End(xlUp).Row
strFile = Dir(FormPath & "*.doc*", vbNormal)
Set rngCopied = Range("A:A")
'For Each fname In Range("A:A")
'If rngCopied.Value <> strFile Then
'If fname.Value = strFile Then
'If strFile <> rngCopied.Value Then
While strFile <> ""
r = r + 1
Set wdDoc = wdApp.Documents.Open(Filename:=FormPath & strFile, AddToRecentFiles:=False, Visible:=False)
With wdDoc
c = 1: WkSht.Cells(r, c) = strFile
'To exclude the Word filename from the data, set c = 0. To include set c = 1: WkSht.Cells(r, c) = strFile.
For Each FmFld In .FormFields
c = c + 1
With FmFld
Select Case .Type
Case Is = wdFieldFormCheckBox
WkSht.Cells(r, c) = .CheckBox.Value
Case Else
WkSht.Cells(r, c) = .Result
End Select
End With
Next
For Each CCtrl In .ContentControls
c = c + 1
With CCtrl
Select Case .Type
Case Is = wdContentControlCheckBox
WkSht.Cells(r, c) = .Checked
Case wdContentControlDate, wdContentControlDropdownList, wdContentControlRichText, wdContentControlText
WkSht.Cells(r, c) = .Range.Text
Case Else
End Select
End With
Next
.Close savechanges:=False
End With
strFile = Dir()
Wend
'End If
'Next fname
wdApp.Quit
Set wdDoc = Nothing: Set wdApp = Nothing: Set WkSht = Nothing
Application.ScreenUpdating = True
End Sub
Aucun commentaire:
Enregistrer un commentaire