每次执行时VBA宏都会变慢

时间:2016-01-12 08:21:53

标签: performance vba word-vba

我有一个逐行读取.txt文件的宏。我检查每一行是否等于新页面的某些代码,比如它" NEXT" - 如果是,则插入分页符。经过一定数量的" NEXT"出现整个文档导出为pdf。然后.doc的内容被删除,我继续阅读&导出txt文件直到EOF。

问题:每次执行时宏都会变慢。

我的测试文件有27300行/ 791 kB(实际文件介于10到100MB之间)。在我启动宏之前,WINWORD进程需要40K的内存。每次执行宏后,内存使用量会变大。

        Time    Max.MemoryUsage  MemoryUsageAfterwards
Run1    11.9s   70K              64K
Run2    19.7s   90K              84K
Run3    22.3s   99K              92K

我知道部分解决方案是手动关闭并重新打开.doc文件,然后使用下一个.txt文件作为输入运行宏。但是,在一次运行宏之后甚至关闭Word需要很长时间,尽管文件中没有我可以看到的内容。

我要问的是,是否还有其他方法可以解决这个问题,我认为是一个内存清除问题?

我的代码:

打开文档时:

Private Sub Document_Open()
    ReadAndSplit
End Sub

全局变量和声明:

Option Explicit
'---------------------------------------------------------------------------
'                                       GLOBAL VARIABLES
'---------------------------------------------------------------------------
Public numOfBreaks  As Integer          ' number of page breaks made
Public numOfPdfs    As Integer          ' number of currently printed pdf
Public filePrefix   As String           ' name prefix for .pdf files
Public sFileName    As String           ' name of Input File
Public breakAfter   As Integer          ' print after this number of NEXT
Public cancelActive As Boolean          ' cancel Button pressed? (for exit)

主要宏:

Sub ReadAndSplit()
'---------------------------------------------------------------------------
'                                       VARIABLES
'---------------------------------------------------------------------------
Dim sLine           As String           ' line from text file
Dim numOfLines      As Long             ' number of lines read from .txt input
Dim execStart       As Single           ' starting time of script execution
Dim nextPage        As Boolean          ' indicates if new document beginns

'---------------------------------------------------------------------------
'                                       INITIAL PROCESSING
'---------------------------------------------------------------------------    
Application.Visible = False              
Application.ScreenUpdating = False       
Selection.WholeStory                    ' clear the document
Selection.Delete
UserForm1.Show                          ' show user dialog
If cancelActive Then                    ' Cancel button handling
    Application.Visible = True
    Exit Sub
End If

With ActiveDocument.PageSetup           ' set page margins & orientation
    .TopMargin = 0.1
    .BottomMargin = 0.1
    .LeftMargin = 0.1
    .RightMargin = 0.1
End With
'---------------------------------------------------------------------------
'                                       MAIN PROCESSING
'---------------------------------------------------------------------------
numOfBreaks = 0                         ' GLOBALS
numOfPdfs = 1
numOfLines = 0                          ' LOCALS
nextPage = True
execStart = Timer

Open sFileName For Input As #1

Do While Not EOF(1)

    If nextPage Then                                    ' write 2 empty lines
        Selection.TypeText (vbNewLine & vbNewLine)
        nextPage = False
    End If

    Line Input #1, sLine                                ' read 1 line from input
    numOfLines = numOfLines + 1                         ' count lines

    If sLine <> "NEXT" Then                             ' test for NEXT
        Selection.TypeText (sLine) & vbNewLine          ' write line from input .txt
    Else
        Selection.InsertBreak Type:=wdPageBreak         ' NEXT -> new page
        numOfBreaks = numOfBreaks + 1                   ' count new receipts

        If numOfBreaks = breakAfter Then                ' compare with PARAM
            PrintAsPDF                                  ' export to pdf
            numOfBreaks = 0
        End If

        nextPage = True                                 ' switch new page on
    End If
Loop

If numOfBreaks <> 0 Then                                ' print out the last part
    PrintAsPDF
End If

Close #1

Debug.Print vbNewLine & "-----EXECUTION-----"
Debug.Print Now
Debug.Print "Lines: " & numOfLines
Debug.Print "Time: " & (Timer - execStart)
Debug.Print "-------------------" & vbNewLine

Selection.WholeStory                                    ' clear the word document
Selection.Delete

Application.Visible = True

End Sub

用于打印PDF的宏:

Sub PrintAsPDF()

Dim newPdfFileName  As String           ' path + name for current .pdf file

newPdfFileName = ActiveDocument.Path & "\" & filePrefix & "-" & numOfPdfs & ".pdf"

Selection.WholeStory                    ' set font
With Selection.Font
    .Name = "Courier New"
    .Size = 10.5
End With

ActiveDocument.SaveAs2 newPdfFileName, 17

numOfPdfs = numOfPdfs + 1

Selection.WholeStory
Selection.Delete

End Sub

UserForm代码:

'---------------------------------------------------------------------------
'                                       OK BUTTON
'---------------------------------------------------------------------------
Private Sub OKButton_Click()

Dim inputFileOk     As Boolean  ' input file path
Dim inputSplitOk    As Boolean  ' split
Dim prefixOk        As Boolean  ' prefix

If FileTxtBox.Text = vbNullString Then          ' validate file path
    inputFileOk = False
    MsgBox ("File path missing!")
Else
    inputFileOk = True
End If

If IsNumeric(SplitTxtBox.Text) Then             ' validate breakAfter
    breakAfter = SplitTxtBox.Text
    inputSplitOk = True
Else
    MsgBox ("Non-numeric value for SPLIT!")
End If

If PrefixTxtBox <> vbNullString Then            ' validate prefix
    filePrefix = PrefixTxtBox.Text
    prefixOk = True
Else
    MsgBox ("Missing prefix!")
End If

                                                ' check if all inputs are ok
If inputFileOk And inputSplitOk And prefixOk Then
    cancelActive = False
    Unload Me
End If

End Sub
'---------------------------------------------------------------------------
'                                       CANCEL BUTTON
'---------------------------------------------------------------------------
Private Sub CancelButton_Click()
cancelActive = True             ' for script termination
Unload Me
End Sub
'---------------------------------------------------------------------------
'                                       FILE BUTTON
'---------------------------------------------------------------------------
Private Sub FileButton_Click()    
Dim i           As Integer      ' file selection index

' show file chooser dialog and assign selected file to sFileName
Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = False
i = Application.FileDialog(msoFileDialogOpen).Show

If i <> 0 Then
    sFileName = Application.FileDialog(msoFileDialogOpen).SelectedItems(1)
    FileTxtBox.Text = sFileName
End If

End Sub

1 个答案:

答案 0 :(得分:3)

Word会在“temp”文件中存储大量信息,以便跟踪“无限制”撤消。如果在不保存文件或清除撤消缓冲区的情况下执行大量操作,则会减慢Word的速度。因此我建议:

  1. 清除撤消缓冲区(ActiveDocument.UndoClear)
  2. 定期保存(空)文档
  3. 为了释放资源。