Перебрать все файлы Word в каталоге

У меня есть следующий код:

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 LoopDirectory()

vDirectory = "C:\programs2\test"

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

Do While vFile <> ""

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

ActiveDocument.WordtoTxtwLB

vFile = Dir
Loop

End Sub

Но это не работает. Как мне заставить это работать, изменяя текущий код или используя новый код?

 Tim Williams17 июл. 2012 г., 19:41
WordtoTxtwLB не является методом ActiveDocument, поэтому просто используйте имя метода само по себе. Лучше адаптируйте свой метод так, чтобы он принимал параметр типа & quot; Документ & quot; и передать открытый документ к нему напрямую.

Ответы на вопрос(3)

Для редактирования всех документов 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

~~~~~~

Решение Вопроса

Вам на самом деле не нужен макрос WordtoTxtwLB. Вы можете объединить оба кода. увидеть этот пример

(UNTESTED)

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 даст вам имя файла с расширением.

 user144006126 июл. 2012 г., 21:32
Как я могу получить это, чтобы применить только к документам .docm?
 26 июл. 2012 г., 21:35
замещатьDir(vDirectory & "*.*") сDir(vDirectory & "*.docm")

Вот мое решение. Я думаю, что для новичков, таких как я, это легко понять, и я буду публиковать здесь свой код. Потому что я искал вокруг, и коды, которые я видел, были довольно сложными. Пошли.

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

Ваш ответ на вопрос