Question

我不是VBA程序员，但一直在研究如何让某项任务变得更容易。我已经能够找出代码来完成我需要的95％但是现在我被困住了，并且不知道正确的关键字来找出解决方案。在此先感谢您的帮助。

背景：我要做的是将Xx页面文档的页眉/页脚部分中的所有文本提取到文本文件。每个页面都是一个具有不同页眉/页脚内容的新部分。我有那部分工作。

Sub test()
'Dim oApp As Word.Application
Dim oDoc As Word.Document
Dim oSec As Word.Section
Dim oPageStart As Word.Range
Dim iPage As Integer, iTotalPages As Integer, iSection As Integer
Dim sHeader As String, sFooter As String, chk1 As String

Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Dim oFile As Object
Set oFile = fso.CreateTextFile("C:\path\Output_Example.txt")

'Open the document
'Set oApp = New Word.Application
Set oDoc = ActiveDocument
iTotalPages = oDoc.ComputeStatistics(wdStatisticPages)


'Retrieve the headers and footers on each page
With oDoc

    iSection = 0

    For iPage = 1 To iTotalPages

        'Go to the page represented by the page number iPage and
        'retrieve its section
        Set oPageStart = oDoc.GoTo(What:=wdGoToPage, _
                                   Which:=wdGoToAbsolute, Count:=iPage)
        Set oSec = oPageStart.Sections(1)

        'If this is a different section than the one in the previous
        'iteration and it has a first page header/.footer, then
        'retrieve the first page header/footer for this section.
        'Otherwise, retrieve the primary header/footer for this section
        If (iSection < oSec.Index) And _
           (oSec.PageSetup.DifferentFirstPageHeaderFooter) Then
            sHeader = oSec.Headers(wdHeaderFooterFirstPage).Range.Text
            sFooter = oSec.Footers(wdHeaderFooterFirstPage).Range.Text
        Else
            sHeader = oSec.Headers(wdHeaderFooterPrimary).Range.Text
            sFooter = oSec.Footers(wdHeaderFooterPrimary).Range.Text
        End If

        iSection = oSec.Index

        oFile.WriteLine "Page " & iPage & ", Section " & iSection & ":"
        oFile.WriteLine "   Header3: " & sHeader
        oFile.WriteLine "   Footer: " & sFooter

    Next

    oFile.Close
    Set fso = Nothing
    Set oFile = Nothing
End With End Sub

上面的代码用于绘制每个页眉/页脚部分中的文本并制作文本文件。

问题：问题是文本缺少任何格式： Example ouput

有没有办法让它看起来更像标题部分中的文字： What the word doc looks like

我不关心左右对齐，我只需要在文本文件中显示换行符。我认为看起来像是特殊字符的盒子，但我似乎无法找到正确的方法来处理它们。

我应该使用Scripting.FileSystemObject以外的其他内容吗？

提前感谢您的帮助。

Answer 1

更改此部分：

oFile.WriteLine "Page " & iPage & ", Section " & iSection & ":"
oFile.WriteLine "   Header3: " & sHeader
oFile.WriteLine "   Footer: " & sFooter

到

oFile.WriteLine "Page " & iPage & ", Section " & iSection & ":"
WriteHeadFootLines sHeader, oFile, "Header3"
WriteHeadFootLines sFooter, oFile, "Footer"

并添加此子：

Sub WriteHeadFootLines(sHeader As String, oFile As Object, sPrefix As String)

    Dim arrHeader() As String
    Dim i As Integer

    arrHeader() = Split(sHeader, Chr(13))

    For i = LBound(arrHeader) To UBound(arrHeader)
        If i = LBound(arrHeader) Then
            oFile.WriteLine "   " & sPrefix & ": " & arrHeader(i)
        Else
            oFile.WriteLine "            " & arrHeader(i)
        End If
    Next i

End Sub

Word VBA - 使文本文件输出看起来正确

1 个答案: