遍历目录中的所有 Word 文件答案

【问题标题】：Loop through all Word Files in Directory遍历目录中的所有 Word 文件
【发布时间】：2022-01-07 16:24:16
【问题描述】：

我有以下代码：

Sub WordtoTxtwLB()
'
' WordtoTxtwLB Macro
'
'
Dim fileName As String
myFileName = ActiveDocument.Name

ActiveDocument.SaveAs2 fileName:= _
"\\FILE\" & myFileName & ".txt", FileFormat:= _
wdFormatText, LockComments:=False, Password:="", AddToRecentFiles:=True, _
WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _
False, Encoding:=1252, InsertLineBreaks:=True, AllowSubstitutions:=False, _
LineEnding:=wdCRLF, CompatibilityMode:=0


End Sub

我想通过一个目录中的所有单词 (.doc) 文件循环这个 sub。我有以下代码：

Sub LoopDirectory()

vDirectory = "C:\programs2\test"

vFile = Dir(vDirectory & "\" & "*.*")

Do While vFile <> ""

Documents.Open fileName:=vDirectory & "\" & vFile

ActiveDocument.WordtoTxtwLB

vFile = Dir
Loop

End Sub

但它不起作用。如何通过更改当前代码或使用新代码来使其正常工作？

【问题讨论】：

WordtoTxtwLB 不是 ActiveDocument 的方法，所以直接使用方法名即可。更好的是，调整您的方法以采用“文档”类型的参数并将打开的文档直接传递给它。

标签： vba ms-word

【解决方案1】：

您实际上并不需要 WordtoTxtwLB 宏。您可以结合这两个代码。看这个例子

Sub LoopDirectory()
    Dim vDirectory As String
    Dim oDoc As Document
    
    vDirectory = "C:\programs2\test\"

    vFile = Dir(vDirectory & "*.*")

    Do While vFile <> ""
        Set oDoc = Documents.Open(fileName:=vDirectory & vFile)
        
        ActiveDocument.SaveAs2 fileName:="\\FILE\" & oDoc.Name & ".txt", _
                               FileFormat:=wdFormatText, _
                               LockComments:=False, _
                               Password:="", _
                               AddToRecentFiles:=True, _
                               WritePassword:="", _
                               ReadOnlyRecommended:=False, _
                               EmbedTrueTypeFonts:=False, _
                               SaveNativePictureFormat:=False, _
                               SaveFormsData:=False, _
                               SaveAsAOCELetter:=False, _
                               Encoding:=1252, _
                               InsertLineBreaks:=True, _
                               AllowSubstitutions:=False, _
                               LineEnding:=wdCRLF, _
                               CompatibilityMode:=0

        oDoc.Close SaveChanges:=False
        vFile = Dir
    Loop
End Sub

顺便说一句，您确定要使用*.* 通配符吗？如果文件夹中有 Autocad 文件怎么办？ ActiveDocument.Name 还会为您提供带有扩展名的文件名。

【讨论】：

我怎样才能让它只适用于 .docm 文档？
用Dir(vDirectory & "*.docm")替换Dir(vDirectory & "*.*")

【解决方案2】：

为了编辑目录中的所有word文档，我构建了这个简单的子程序。

子程序循环遍历目录并打开它找到的每个 *.doc 文件。然后在它调用的打开的文档文件上第二个子程序。第二个子例程完成后，文档已保存，然后关闭。

Sub DoVBRoutineNow()
Dim file
Dim path As String


path = "C:\Documents and Settings\userName\My Documents\myWorkFolder\"

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

Call secondSubRoutine

ActiveDocument.Save
ActiveDocument.Close

file = Dir()
Loop
End Sub

~~~~~~

【讨论】：

【解决方案3】：

这是我的解决方案。我认为对于像我这样的新手来说很容易理解和直接，我将在这里发布我的代码。因为我四处搜索，我看到的代码有点复杂。我们走吧。

Sub loopDocxs()
Dim wApp As Word.Application 
Dim wDoc As Word.Document 
Dim mySource As Object
Set obj = CreateObject("Scripting.FileSystemObject")
Set mySource = obj.GetFolder("D:\docxs\")

For Each file In mySource.Files 'loop through the directory
  If Len(file.Name) > 0 And InStr(1, file.Name, "$") = 0 Then '$ is temp file mask

    Set wApp = CreateObject("Word.Application")
    wApp.Visible = True
    'Word.Application doesn't recognize file here event if it's a word file.
    'fortunately we have the file name which we can use.
    Set wDoc = wApp.Documents.Open(mySource & "\" & file.Name, , ReadOnly)

    'Do your things here which will be a lot of code

    wApp.Quit
    Set wApp = Nothing


  End If
Next file

【讨论】：