Question

这是我工作的最后一步。我设计了一个代码来从Word文档中检索表。我编写了一个适用于每个Word文档的代码。我有成千上万的Word文档，我很乐意自动化这个过程。

换句话说，我想在同一个文件夹中运行所有.doc文件的代码，但我似乎无法理解它。

（开始）代码如下所示：

Sub importTableDataWord()
Dim ws As Worksheet
Set ws = Sheets("Sheet1")
'We declare object variables for Word Application and document
Dim wdApp As Object, wddoc As Object
'Declare a string variable to access our Word document
Dim strDocName As String

'Designate Word
'Error handling
On Error Resume Next
'Create a Word application if Word is not already open
Set wdApp = CreateObject("Word.Application")
wdApp.Visible = True
strDocName = "C:\Users\PDX\Documents\CBA01.doc"
'Check relevant directory for relevant document
'If not found then inform the user and close program
If Dir(strDocName) = "" Then
    MsgBox "The file " & strDocName & vbCrLf & _
    "was not found in the folder path" & vbCrLf & _
    "C:\our-inventory\.", _
    vbExclamation, _
    "Sorry, that document name does not exist."
Exit Sub
End If

'Open/activate the designated Word
wdApp.Activate
Set wddoc = wdApp.Documents(strDocName)
If wddoc Is Nothing Then Set wddoc = wdApp.Documents.Open(strDocName)
wddoc.Activate

'Define variables to access the tables in the word document
Dim Tble As Integer
Dim rowWd As Long
Dim colWd As Integer
Dim x As Long, y As Long
x = 1
y = 1


''''' FIRST LINE, FIRST TABLE

'Count nb of tables in my Word
With wddoc
Tble = wddoc.Tables.Count
    If Tble = 0 Then
    MsgBox "No Tables found in the Word document", vbExclamation, "No Tables to Import"
Exit Sub
End If

'Start the looping process to access tables and their rows, columns
For i = 1 To 1
    With .Tables(i)
    For colWd = 1 To .Columns.Count
    Cells(x, y) = WorksheetFunction.Clean(.cell(1, colWd).Range.Text)
    'Access next column until the end
    y = y + 1
    Next colWd
    'go to next row and start from column 1
    y = 1
    x = x + 1
End With
Next
End With

wdApp.Quit
End Sub

我正在考虑使用类似下面的内容，但无法找到创建循环来应用代码的方法！

'set folder where all the .doc are located
myFolder = "C:\Users\PDX\Documents\"
strFile = Dir(myFolder & "\*.doc", vbNormal)
While strFrile <> ""
Set wddoc = wdApp.Documents.Open(Filename:=myFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=True)

'Open/activate the designated Word
wdApp.Activate
Set wddoc = wdApp.Documents(strDocName)
If wddoc Is Nothing Then Set wddoc = wdApp.Documents.Open(strDocName)
wddoc.Activate

但我也想过创建一个子调用我的主要子：

Sub testhello()
Dim file
Dim path As String


path = "C:\Users\PDX\Documents\"

file = Dir(path & "*.doc")
Do While file <> ""
Documents.Open Filename:=path & file

Call importTableDataWord

ActiveDocument.Save
ActiveDocument.Close

file = Dir()
Loop

End Sub
Ideally, 1 w

理想情况下，循环将使得检索到的1个单词表= 1个电子表格，或者，检索到的下一个表格将出现在最后一行之后。

任何反馈意见。如果您了解其中的一些或有任何提示，请随时提出建议！

Answer 1

我会使用你的第二种方法，有一个循环来扫描文件夹中的所有单词文件，每次它找到一个新单词文档时，它会调用另一个执行你想要的所有任务的Sub。

First Sub ：遍历文件夹中的所有Word文件

Option Explicit

Dim wb As Workbook
Dim path As String
Dim myFile As String
Dim myExtension As String
Dim myFolder As FileDialog
Dim wdApp As Object, wddoc As Object


Sub Loop_AllWordFiles_inFolder()

Set wdApp = CreateObject("Word.Application")

'Optimize Macro Speed
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

'Retrieve Target Folder Path From User
Set myFolder = Application.FileDialog(msoFileDialogFolderPicker)

With myFolder
    .Title = "Select A Target Folder"
    .AllowMultiSelect = False
    If .Show <> -1 Then GoTo NextCode
    path = .SelectedItems(1) & "\"
End With

' if the User select "Cancel"
NextCode:
path = path
If path = "" Then GoTo ResetSettings

' Target File Extension
myExtension = "*.doc"

' Target Path with Ending Extention
myFile = Dir(path & myExtension)
' Loop through all doc files in folder
Do While myFile <> ""
    Set wddoc = wdApp.Documents.Open(Filename:=path & myFile)

    ' HERE you call your other routine
    Call importTableDataWord

    wddoc.Close SaveChanges:=True
    myFile = Dir
Loop

MsgBox "Finished scanning all files in Folder " & path

ResetSettings:

' Reset Macro Optimization Settings
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

Set wdApp = Nothing

End Sub

第二个子：只使用此处的其余现有代码（从所有表中执行所有数据导入。

Sub importTableDataWord()

' put all you code here...

End Sub

Answer 2

代码中的以下行需要适当的引用或驱动程序才能安装。如果找不到它们，可以删除代码中的所有行。然后你会发现它适合你。

Dim wb As Workbook
Application.ScreenUpdating = False
Application.EnableEvents = False

Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic

打开文件夹中的所有.doc文件并应用代码

2 个答案: