1
我有一个宏，它可以逐行读取.txt文件。我检查每一行，如果它等于一个新页面的代码，说它是“下一个” - 如果是的话，那么插入一个分页符。在出现一定量的“NEXT”后，整个文档将被导出为pdf。然后.doc的内容被删除，我继续阅读&导出txt文件，直到EOF。每次执行VBA宏都会变慢
问题：宏在每次执行时都会变慢。
我的测试文件有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
用户窗体代码：
'---------------------------------------------------------------------------
' 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
我认为我们需要看到你的整个代码来回答什么是放慢你的宏。也许尝试将您的整个代码发布到codereview.stackexchange.com？ –
对于[codereview.se]，这可能是一个好问题，只要：**（A）** _代码works_，**和（B）** _it不以任何方式假设或不完整。在发布之前，请阅读[主题指南]（http://codereview.stackexchange.com/help/on-topic），如果您选择转到[代码评论]（http://codereview.stackexchange.com/问题/卖出）。如果您有任何问题或疑虑，请加入我们的[CR帮助台]（http://chat.stackexchange.com/rooms/34045）。 – Quill
你真的关闭过sFileName吗？ –