为什么每次使用 VBA 保存 word 文档时文件大小都会增加？
Why is the file size growing each time the word document is saved using VBA?
我有一个 VBA 我写的宏，它从电子表格中获取数据以生成 word 文档。
在大多数情况下，生成的所有信息都完全相同，除了一些表示联系信息和金额的字段。所有文件开始时都以 17kb 保存，但随着宏 运行 通过电子表格，这些文件的大小会增加。在大约 2500 次保存后，文件达到 48kb。
我不确定为什么会这样。我在想，每次删除并再次写入文档后，可能会保留某种元数据。
我已经尝试了一些方法来删除元数据，但我不确定我这样做是否正确，因为在这类问题上我找不到很多东西。
为了让这个 运行 快一点，我构建了宏来打开一个空白的 word 文档，然后当它循环遍历电子表格上的所有行时，将最终信息复制到 word doc, SaveAs 一个文件夹中的唯一值，然后删除单词 doc 的内容，然后再次执行整个操作，直到遍历工作表上的所有行。
我生成文件的方式是否导致 word docx 文件增长？
进入每个生成的文件（数百个）后，它似乎平均每个生成的新文档增长 20b。所以文件大小缓慢但每次保存都会不断增长。
以下是保存的每个新文档的增长情况示例。
这是知识库如何随时间增长的示例。
这是精简的整体宏。
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
经过一些猜测后，我至少弄清楚了每次保存文件时哪个对象保留了日期。
我最终不得不完全关闭并设置为 Nothing objDoc 然后重新添加 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
我有一个 VBA 我写的宏，它从电子表格中获取数据以生成 word 文档。
在大多数情况下，生成的所有信息都完全相同，除了一些表示联系信息和金额的字段。所有文件开始时都以 17kb 保存，但随着宏 运行 通过电子表格，这些文件的大小会增加。在大约 2500 次保存后，文件达到 48kb。
我不确定为什么会这样。我在想，每次删除并再次写入文档后，可能会保留某种元数据。
我已经尝试了一些方法来删除元数据，但我不确定我这样做是否正确，因为在这类问题上我找不到很多东西。
为了让这个 运行 快一点，我构建了宏来打开一个空白的 word 文档，然后当它循环遍历电子表格上的所有行时，将最终信息复制到 word doc, SaveAs 一个文件夹中的唯一值，然后删除单词 doc 的内容，然后再次执行整个操作，直到遍历工作表上的所有行。
我生成文件的方式是否导致 word docx 文件增长？
进入每个生成的文件（数百个）后，它似乎平均每个生成的新文档增长 20b。所以文件大小缓慢但每次保存都会不断增长。
以下是保存的每个新文档的增长情况示例。
这是知识库如何随时间增长的示例。
这是精简的整体宏。
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
经过一些猜测后，我至少弄清楚了每次保存文件时哪个对象保留了日期。
我最终不得不完全关闭并设置为 Nothing objDoc 然后重新添加 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