У меня есть макрос VBA, который я написал и который берет данные из электронной таблицы для создания текстовых документов.
По большей части вся генерируемая информация точно такая же, за исключением нескольких полей, которые обозначают контактную информацию и суммы. Все файлы вначале сохраняются на 17 КБ, но по мере того, как макрос проходит через электронную таблицу, эти размеры файлов увеличиваются. Приблизительно после 2500 сохранений файлы были до 48 КБ.
Я не уверен, почему это происходит. Я думал, что, возможно, какие-то метаданные сохраняются после каждого удаления документа и повторной записи.
Я пробовал несколько вещей, чтобы удалить метаданные, но я не уверен, что я делаю это правильно, потому что не так уж много я мог найти по этому вопросу.
В попытке сделать этот запуск немного быстрее, я построил макрос, чтобы открыть пустой текстовый документ, а затем, когда он перебирает все строки в электронной таблице, копирует окончательную информацию в слово 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