如果文件名不在范围内，则从文件读入工作表

Question

我有一个宏，从文件夹（FormPath）中的每个Word文件（strFile）中的内容控件读取数据到工作表中的行，包括在列A中插入Word文件名。

我不希望每次都读取每个Word文件，而是希望宏只从那些尚未处理过的Word文件中读取数据（即如果文件名在A列中，则忽略该文件）。

我已经做了各种尝试而没有成功，如注释掉的代码所示。

帮助感激地收到了！

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

Answer 1

你很亲密（我只是做相关的一点）：

Dim fname As Range
Dim OKToCopy as Boolean
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")

Do Until strfile = ""
   OKToCopy = true 'assume true
   For Each fname In Range("A:A")
      If fname.text = strfile then
          OKToCopy = false
          Exit For
      End IF

   Next Fname

   If OkToCopy then  
      r = r + 1
     'etc