为什么每次使用VBA保存Word文档时文件大小都会增加?

时间:2019-07-11 19:55:51

标签: excel vba ms-word save-as

我有一个编写的VBA宏,该宏从电子表格中获取数据以生成Word文档。

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

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

我已经尝试了一些操作来删除元数据,但是我不确定这样做是否正确,因为在这种问题上我找不到很多东西。

为了使运行速度更快一点,我建立了宏以打开空白的Word文档,然后在电子表格上所有行循环时,将最终信息复制到word doc中,另存为一个唯一值在文件夹中,然后删除单词doc的内容,然后重新进行整个操作,直到遍历工作表上的所有行为止。

关于我如何生成导致docx文件一词增长的文件,有什么问题吗?

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

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

enter image description here

以下是知识库随着时间增长的示例。

enter image description here

这是整个宏的精简版。

addLink() {
if(
  this.product.name !== '' && 
  this.product.price !== 0 && 
  this.product.instaURL !== '') {
    let uid;
    firebase.auth().onAuthStateChanged(function(user) {
      if (user) {
        uid = user.uid;
        console.log(uid)  //THIS WORK
      }
    });      
  console.log(uid); //THIS ALSO WORKS ;)
  this.productService.addProduct(this.product);      
  this.product = {} as Product;
}

1 个答案:

答案 0 :(得分:0)

经过一番猜测之后,每次保存文件时,我至少都弄清楚了哪个对象在保存日期。

我最终不得不完全关闭并将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