WORDファイルを別のヘッダーで.txtに変換するにはどうすればよいですか？

Question

私はマクロで読み込んだ複数の異なる単語のファイル（〜5000）を持っていて、これらの複数の単語の文書を1つの文書にフォルダに入れます。ここで

関連するコード：

Sub MergeDocs() 
    Dim rng As Range 
    Dim MainDoc As Document 
    Dim strFile As String, strFolder As String 
    Dim Count As Long 
    With Application.FileDialog(msoFileDialogFolderPicker) 
     .Title = "Pick folder" 
     .AllowMultiSelect = False 
     If .Show Then 
      strFolder = .SelectedItems(1) & Application.PathSeparator 
     Else 
      Exit Sub 
     End If 
    End With 
    Set MainDoc = Documents.Add 
    strFile = Dir$(strFolder & "*.doc") ' can change to .docx 
    Count = 0 
    Do Until strFile = "" 
     Count = Count + 1 
     Set rng = MainDoc.Range 
     With rng 
      .Collapse wdCollapseEnd 
      If Count > 1 Then 
       .InsertBreak wdSectionBreakNextPage 
       .End = MainDoc.Range.End 
       .Collapse wdCollapseEnd 
      End If 
      .InsertFile strFolder & strFile 
     End With 
     strFile = Dir$() 
    Loop 
    MsgBox ("Files are merged") 
lbl_Exit: 
    Exit Sub 
End Sub 

それが動作しているが、私は.txtのようにファイルを保存しようとしていたときに、ヘッダ+フッタはそれを私はこのヘッダーを保存することができます1どのような方法をlose..is .txtファイルにも含まれていますか？ （私が書いたように、すべてのドキュメントで異なるヘッダーを持っている。）

EDIT：

Sub MergeDocs() 
    Dim rng As Range 
    Dim MainDoc As Document 
    Dim strFile As String, strFolder As String 
    Dim Count As Long 
    With Application.FileDialog(msoFileDialogFolderPicker) 
     .Title = "Pick folder" 
     .AllowMultiSelect = False 
     If .Show Then 
      strFolder = .SelectedItems(1) & Application.PathSeparator 
     Else 
      Exit Sub 
     End If 
    End With 
    Set MainDoc = Documents.Add 
    strFile = Dir$(strFolder & "*.doc") ' can change to .docx 
    Count = 0 
    Dim doc As Document 
    Dim head As String, foot As String 

    Do Until strFile = "" 
     Set doc = Documents.Open(strFile) 
     head = doc.Sections(1).Headers(wdHeaderFooterPrimary).Range.Text 
     foot = doc.Sections(1).Footers(wdHeaderFooterPrimary).Range.Text 
     doc.Close False 

     Count = Count + 1 
     Set rng = MainDoc.Range 
     With rng 
      .Collapse wdCollapseEnd 
      If Count > 1 Then 
       .InsertBreak wdSectionBreakNextPage 
       .End = MainDoc.Range.End 
       .Collapse wdCollapseEnd 
     End If 
     .InsertAfter head 
     .InsertParagraphAfter 
     .InsertFile strFolder & strFile 
     .InsertAfter foot 
    End With 
    strFile = Dir$() 
Loop 
    MsgBox ("Files are merged") 
lbl_Exit: 
    Exit Sub 
End Sub 

Answer 1

これは完全にテストされていませんが、あなたが行くを取得する必要があります。

Doループのみを変更しました。置き換えて試してみて楽しんでください：

Dim doc As Document 
Dim head As String, foot As String 

Do Until strFile = "" 
    Set doc = Documents.Open(strFolder & strFile) 
    head = doc.Sections(1).Headers(wdHeaderFooterPrimary).Range.text 
    foot = doc.Sections(1).Footers(wdHeaderFooterPrimary).Range.text 
    doc.Close False 

    Count = Count + 1 
    Set rng = MainDoc.Range 
    With rng 
     .Collapse wdCollapseEnd 
     If Count > 1 Then 
      .InsertBreak wdSectionBreakNextPage 
      .End = MainDoc.Range.End 
      .Collapse wdCollapseEnd 
     End If 
     .InsertAfter head 
     .InsertParagraphAfter 
     .InsertFile strFolder & strFile 
     .InsertAfter foot 
    End With 
    strFile = Dir$() 
Loop