Word VBA - 获取文本文件输出看起来是正确的 [英] Word VBA - getting text file output to look right

问题描述

我不是一个VBA程序员，但一直在研究如何使某个任务更容易。我已经能够找出代码来做我需要的95％的东西，但是现在我被卡住了，不知道正确的关键字来找出解决方案。感谢您的帮助。

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

pre $ Sub $ test $ b $ 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）

打开文档
'Set oApp = New Word.Application
Set oDoc = ActiveDocument
iTotalPages = oDoc.ComputeStatistics（wdStatisticPages）


检索每页的页眉和页脚
使用oDoc

iSection = 0

iPage = 1 To iTotalPages

'转到页码iPage和
'检索其部分
Set oPageStart = oDoc.GoTo （什么：= wdGoTo Page，_
其中：= wdGoToAbsolute，Count：= iPage）
设置oSec = oPageStart.Sections（1）

'如果这是一个不同于前面的
'迭代，它有一个首页页眉/ .footer，然后
'检索本部分的首页页眉/页脚。
'否则，检索此部分的主页眉/页脚
如果（iSection （oSec.PageSetup.DifferentFirstPageHeaderFooter）则
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.WriteLinePage& iPage& ，部分和 iSection& ：
oFile.WriteLineHeader3：& sHeader
oFile.WriteLineFooter：& sFooter

Next

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

上面的代码用来绘制每个页眉/页脚部分的文本，并生成一个文本文件。

问题：
问题在于文本没有任何格式：
示例输出

有没有办法让它看起来更像标题部分的文字：
doc的文字看起来像

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

我应该使用<$ c $以外的东西c> Scripting.FileSystemObject ？

感谢您的帮助。

解决方案

更改此部分：

  oFile.WriteLinePage& iPage& ，部分和 iSection& ：
 oFile.WriteLineHeader3：& sHeader 
 oFile.WriteLineFooter：& sFooter 
  

到

  oFile.WriteLinePage& iPage& ，部分和 iSection& ：
 WriteHeadFootLines sHeader oFileHeader3
 WriteHeadFootLines sFooter oFileFooter
 $ $ $ 
 
然后添加这个子文件：
 
 $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ 
 
 Dim arrHeader（）As String 
 Dim i As Integer 
 
 arrHeader（）= Split（sHeader，Chr（13））
 
对于i = LBound（arrHeader）到UBound（arrHeader）
如果我= LBound（arrHeader）然后
 oFile.WriteLine& sPrefix& ：& arrHeader（i）
 Else 
 oFile.WriteLine& arrHeader（i）
 End If 
 Next i 
 
 End Sub 
  

I'm not a VBA programmer but have been researching how to make a certain task easier. I've been able to figure out code to do 95% of what I need but now I'm stuck and don't know the correct keywords to figure out a solution. Thanks in advance for your help.

Background: What I'm trying to do is extract all the text in the header/footer section of an Xx page document to a text file. Every page is a new section with different header/footer content. I have that part working.

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

The above code works to grap the text in each header/footer section and makes a text file.

The Problem: The problem is that the text lacks any formatting: Example ouput

Is there a way to make it look more the text in the header section: What the word doc looks like

I don't care about the right and left justification, I just need the line breaks to show up in the text file. I assume the box looking things are special characters but i can't seem to find the right way to handle them.

Should i be using something other than Scripting.FileSystemObject?

Thanks in advance for any help.

解决方案

Change this section:

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

to

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

And add this sub:

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 - 获取文本文件输出看起来是正确的的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！