6

次のコードがあります。

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

しかし、それは機能していません。現在のコードを変更するか、新しいコードを使用して、これを機能させるにはどうすればよいですか?

4

3 に答える 3

14

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、拡張子付きのファイル名も表示されます。

于 2012-07-17T21:34:46.870 に答える
2

ディレクトリ内のすべての単語文書を編集するために、この単純なサブルーチンを作成しました。

サブルーチンはディレクトリをループし、見つかった各 *.doc ファイルを開きます。次に、開いているドキュメント ファイルで、2 番目のサブルーチンを呼び出します。2 番目のサブルーチンが終了すると、ドキュメントは保存されてから閉じられます。

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

~~~~~~

于 2016-03-22T01:06:07.720 に答える
0

これが私の解決策です。ここにコードを投稿することは、私のような初心者にとって理解しやすく、簡単だと思います。色々と調べてみると、コードがちょっと複雑だったからです。さあ行こう。

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
于 2018-08-14T12:38:44.717 に答える