为啥每次使用 VBA 保存 word 文档时文件大小都会增加？

Posted 2023-05-07

【中文标题】为啥每次使用 VBA 保存 word 文档时文件大小都会增加？

【英文标题】：Why is the file size growing each time the word document is saved using VBA?为什么每次使用 VBA 保存 word 文档时文件大小都会增加？

【发布时间】：2019-07-11 19:55:51

【问题描述】：

我编写了一个 VBA 宏，它从电子表格中获取数据以生成 word 文档。

在大多数情况下，生成的所有信息都完全相同，除了一些表示联系信息和金额的字段。所有文件开始时都保存为 17kb，但随着宏在电子表格中运行，这些文件大小会增加。大约 2500 次保存后，文件最大为 48kb。

我不确定为什么会这样。我在想，每次删除并再次写入文档后，可能会保留某种元数据。

我尝试了一些方法来删除元数据，但我不确定我是否正确地执行此操作，因为在这类问题上我找不到很多。

为了让这个运行更快一点，我构建了一个宏来打开一个空白的 word 文档，然后当它循环遍历电子表格上的所有行时，将最终信息复制到 word doc，SaveAs 一个唯一值在一个文件夹中，然后删除单词 doc 的内容，然后重新执行整个操作，直到它遍历工作表上的所有行。

我生成文件的方式是否会导致单词 docx 文件的增长？

进入每个生成的文件（数百个）后，每个生成的新文档似乎平均增长了 20b。因此文件大小缓慢但每次保存都会不断增长。

这里是每个保存的新文档的增长情况示例。

以下是 KB 如何随时间增长的示例。

这里是精简的整体宏。

Sub GenerateLetterForSelectedMonth()
    Dim temp_wb, data_wb As Workbook
    Dim temp_ws, data_ws As Worksheet
    Dim ltr_str1, ltr_str2, wb_dir, file_path As String
    Dim account_num, cust_name, non_etf_amt, etf_amt, plcmt_amt, mex_act, adr1, adr2, city, state, zip, country, cont_name As String
    Dim last_row1 As Long
    Dim objWord As Object
    ' Dim objWord As New Word.Application
    Dim objDoc As Word.Document
    Dim fd As Office.FileDialog

    Set temp_wb = ActiveWorkbook
    Set temp_ws = temp_wb.Worksheets(1)
    wb_dir = temp_wb.Path

    ' Select file to process '
    Set fd = Application.FileDialog(msoFileDialogFilePicker)

    ' open file to process '
    Set data_wb = Workbooks.Open(file_path)
    Set data_ws = data_wb.Worksheets(1)

    ' get last row of file being processed '
    last_row1 = data_ws.Range("A" & data_ws.Rows.Count).End(xlUp).Row

    ' check for todays folder if not exist then create '
    Dim path_ As String
    path_ = wb_dir & "\DOCS " & Format(Now, "MMMM-dd-yyyy")

    With CreateObject("Scripting.FileSystemObject")
        If Not .FolderExists(path_) Then .CreateFolder path_
    End With


    Set objWord = CreateObject("Word.Application")
    Set objDoc = objWord.Documents.Add
    objWord.Visible = False

    For i = 2 To last_row1

        mex_act = UCase(data_ws.Cells(i, 7).Value)
        account_num = data_ws.Cells(i, 1)
        cust_name = data_ws.Cells(i, 2)
        non_etf_amt = data_ws.Cells(i, 3)
        etf_amt = data_ws.Cells(i, 5)
        plcmt_amt = data_ws.Cells(i, 6)
        adr1 = data_ws.Cells(i, 8)
        adr2 = data_ws.Cells(i, 9)
        city = data_ws.Cells(i, 10)
        state = data_ws.Cells(i, 11)
        zip = data_ws.Cells(i, 12)
        country = data_ws.Cells(i, 13)
        cont_name = WorksheetFunction.Proper(data_ws.Cells(i, 14))

        temp_ws.Cells(3, 1).Value = _
            Format(Now, "MMMM-dd-yyyy") & vbNewLine & cust_name & vbCr & adr1 & " " & adr2 & vbCr & city & ", " & state & " " & zip & vbNewLine & _
            "redacted for post " & "****" & Mid(account_num, 5, 10) & vbNewLine & "Dear " & cont_name & ":" & vbNewLine & "redacted for post" & plcmt_amt & _
            "redacted for post" & vbNewLine & "redacted for post" & non_etf_amt & vbCr & "redacted for post" & etf_amt & vbNewLine & "redacted for post" _

        'Copy the range Which you want to paste in a New Word Document
        temp_ws.Range("A2:A6").Copy

        With objWord
            .Selection.WholeStory
            .Selection.Paste
            .DefaultTableSeparator = " "
        End With

        objWord.ActiveDocument.RemoveDocumentInformation (wdRDIAll)
        objDoc.SaveAs Filename:=path_ & "\" & data_ws.Cells(i, 1)

        With objWord
            objDoc.Range(0, 0).Select
            .Selection.WholeStory
            .Selection.Delete
        End With
        Debug.Print (i)
    Next i

    objWord.Quit SaveChanges:=wdDoNotSaveChanges

End Sub

【问题讨论】：

如果我理解得很好：案例 1 你的代码一次生成 10 个相同的 word 文档（唯一的区别是信息，但数量是相同的）。第一个文件大小为 17k，第 10 个文件大小为 17k + 20k*9，即使它包含的信息量与第一个文件相同。 案例 2 您运行宏来生成 1 个大小为 17k 的单字文档。您将这个练习重复 9 次，每个文档的大小为 17k（因为每个文档都是每次运行的第一个）。我说对了吗？

您是否在跟踪更改？ （见：评论标签）

是的。我想我已经找到了解决方案。我更改了colde的一部分，在保存objDoc后它执行.Close然后Set objDoc = Nothing，这似乎已经修复了文件增长。因此，objDoc 中的某些内容会在每次保存后保留一些信息。我只是不知道在这一点上。

@MatteoNNZ 每次保存文件大小仅增加 5 到 20 个字节。在生成的 2500 个文档中，这总共增加了 48kb。我至少发现每次保存获取数据的部分是单词 object 中的实际 doc 对象。

我认为 MS Word 代码不会公开这样的 API 来转储缓存。我认为该对象的行为就像一个标准的 Word 文档（最终用户的 Word 不提供任何这些功能）。每次运行重新初始化它有什么问题？它会减慢您的宏吗？

【参考方案1】：

经过一些猜测工作，我确实至少弄清楚了每次保存文件时保存的对象是什么。

我最终不得不完全关闭并设置为NothingobjDoc，然后在每次循环运行时重新添加objDoc。这消除了我正在查看的文件大小的增长。

我仍然不知道它为什么会增长，所以如果有人知道这一点，我很想知道它为什么会发生，而不仅仅是发生了什么。

如果有人感兴趣，新代码如下：

Sub GenerateLetterForSelectedMonth()
    Dim temp_wb, data_wb As Workbook
    Dim temp_ws, data_ws As Worksheet
    Dim ltr_str1, ltr_str2, wb_dir, file_path As String
    Dim account_num, cust_name, non_etf_amt, etf_amt, plcmt_amt, mex_act, adr1, adr2, city, state, zip, country, cont_name As String
    Dim last_row1 As Long
    Dim objWord As Object
    ' Dim objWord As New Word.Application
    Dim objDoc As Word.Document
    Dim fd As Office.FileDialog

    Set temp_wb = ActiveWorkbook
    Set temp_ws = temp_wb.Worksheets(1)
    wb_dir = temp_wb.Path

    ' Select file to process '
    Set fd = Application.FileDialog(msoFileDialogFilePicker)

    ' open file to process '
    Set data_wb = Workbooks.Open(file_path)
    Set data_ws = data_wb.Worksheets(1)

    ' get last row of file being processed '
    last_row1 = data_ws.Range("A" & data_ws.Rows.Count).End(xlUp).Row

    ' check for todays folder if not exist then create '
    Dim path_ As String
    path_ = wb_dir & "\DOCS " & Format(Now, "MMMM-dd-yyyy")

    With CreateObject("Scripting.FileSystemObject")
        If Not .FolderExists(path_) Then .CreateFolder path_
    End With


    Set objWord = CreateObject("Word.Application")

    For i = 2 To last_row1
        Set objDoc = objWord.Documents.Add ' ADDED THIS LINE
        mex_act = UCase(data_ws.Cells(i, 7).Value)
        account_num = data_ws.Cells(i, 1)
        cust_name = data_ws.Cells(i, 2)
        non_etf_amt = data_ws.Cells(i, 3)
        etf_amt = data_ws.Cells(i, 5)
        plcmt_amt = data_ws.Cells(i, 6)
        adr1 = data_ws.Cells(i, 8)
        adr2 = data_ws.Cells(i, 9)
        city = data_ws.Cells(i, 10)
        state = data_ws.Cells(i, 11)
        zip = data_ws.Cells(i, 12)
        country = data_ws.Cells(i, 13)
        cont_name = WorksheetFunction.Proper(data_ws.Cells(i, 14))

        temp_ws.Cells(3, 1).Value = _
            Format(Now, "MMMM-dd-yyyy") & vbNewLine & cust_name & vbCr & adr1 & " " & adr2 & vbCr & city & ", " & state & " " & zip & vbNewLine & _
            "redacted for post " & "****" & Mid(account_num, 5, 10) & vbNewLine & "Dear " & cont_name & ":" & vbNewLine & "redacted for post" & plcmt_amt & _
            "redacted for post" & vbNewLine & "redacted for post" & non_etf_amt & vbCr & "redacted for post" & etf_amt & vbNewLine & "redacted for post" _

        'Copy the range Which you want to paste in a New Word Document
        temp_ws.Range("A2:A6").Copy

        With objWord
            .Selection.WholeStory
            .Selection.Paste
            .DefaultTableSeparator = " "
        End With

        objWord.ActiveDocument.RemoveDocumentInformation (wdRDIAll)
        objDoc.SaveAs Filename:=path_ & "\" & data_ws.Cells(i, 1)
        objDoc.Close  ' ADDED THIS LINE
        Set objDoc = Nothing  ' ADDED THIS LINE

    Next i

    objWord.Quit SaveChanges:=wdDoNotSaveChanges

End Sub

【讨论】：

我一直在考虑这个问题，试图挖掘过去 20 年来我所听到和阅读的所有内容......最好的可能是在最终用户金星中询问，因为那里的人可能有一次又一次地重新保存文档时的行为体验。 重要：指定Word的版本，不要提及代码。您还可以在 Open XML SDK Productivity Tool 中打开两个这样的文档，并使用比较功能来查看底层 Word Open XML 的不同之处——这应该会给您提供重要的线索...

...您也可以尝试重新打开其中一个，然后保存并再次关闭（这可能会删除之前编辑中保留的“剩余部分”）。大多数情况下，Word 将“撤消”信息保存在文档之外，但它很可能会在文档内部进行一些内部跟踪...

@CindyMeister 重新打开选项大大减慢了宏。保存关闭然后创建新单词对象也是如此。我需要在不大量增加运行宏的时间的情况下解决这个问题。不过，当我重新开始工作时，我可能会前往最终用户并发布。感谢您的信息。

您问为什么会发生这种情况。我的发言是针对这一点的，而不是作为实现目标的可能方法。为了实现您的目标，您应该从 template (dotx) 开始，并为每个新文档使用 Documents.Add，而不是尝试重复使用同一个文档。这是标准的 Word 用法，无论是对于最终用户还是开发人员......