Размер рабочей книги с макросами увеличивается при каждом запуске моего макроса VBA? - PullRequest
0 голосов
/ 16 января 2020

Я использую пакетный файл со следующим кодом:

cscript DeleteDuplicateDataMacro.vbs "C:\Users\techadmin\Documents\DeleteDuplicateDataMacro\DeleteDuplicateDataMacro.xlsm

, который запускает этот код VBScript:

Dim args, objExcel

Set args = wScript.Arguments
Set objExcel = CreateObject("Excel.Application")

objExcel.Workbooks.Open args(0)
objExcel.Visible = True

ObjExcel.Run "DeleteDuplicateData"

objExcel.ActiveWorkbook.Save
objExcel.ActiveWorkbook.Close(0)
objExcel.Quit

, который открывает мою книгу с поддержкой макросов и запускает следующий макрос:

Sub DeleteDuplicateData()  
'  
' DeleteDuplicateData Macro  
'  

'  
    Application.DisplayAlerts = False  
    **With ActiveSheet.QueryTables(1).Refresh _
        .Connection = "TEXT;C:\Users\techadmin\Documents\Sapphire Report Agent\Sapphire_NK_Export.csv"**  
        '.CommandType = 0  
        .Name = "Sapphire_NK_Export"  
        .FieldNames = True  
        .RowNumbers = False  
        .FillAdjacentFormulas = False  
        .PreserveFormatting = True  
        .RefreshOnFileOpen = False  
        .RefreshStyle = xlInsertDeleteCells  
        .SavePassword = False  
        .SaveData = True  
        .AdjustColumnWidth = True  
        .RefreshPeriod = 0  
        .TextFilePromptOnRefresh = False  
        .TextFilePlatform = 437  
        .TextFileStartRow = 1  
        .TextFileParseType = xlDelimited  
        .TextFileTextQualifier = xlTextQualifierDoubleQuote  
        .TextFileConsecutiveDelimiter = False  
        .TextFileTabDelimiter = False  
        .TextFileSemicolonDelimiter = False  
        .TextFileCommaDelimiter = True  
        .TextFileSpaceDelimiter = False  
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 3, 1, 1, 1, 1, 1)  
        .TextFileTrailingMinusNumbers = True  
        .Refresh BackgroundQuery:=False  
    End With  
    ActiveWindow.SmallScroll Down:=-9  
    ActiveSheet.Range("$A$1:$Q$2500").RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17), Header:=xlYes  
    ActiveSheet.Range("$A$1:$Q$2500").RemoveDuplicates Columns:=17, Header:=xlYes  
    ChDir "C:\Users\techadmin\Documents\Sapphire Report Agent"  
    ActiveWorkbook.SaveAs Filename:="C:\Users\techadmin\Documents\Sapphire Report Agent\Sapphire_NK_Export", FileFormat:=xlCSV, CreateBackup:=False  
    ActiveCell.FormulaR1C1 = "STATE_STUDENT_ID"  
    Range("A1:Q2500").Select  
    Range("A1").Activate  
    Selection.ClearContents  
    Range("A1").Select  
    ChDir "C:\Users\techadmin\Documents\DeleteDuplicateDataMacro"  
    ActiveWorkbook.SaveAs Filename:="C:\Users\techadmin\Documents\DeleteDuplicateDataMacro\DeleteDuplicateDataMacro", FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False  
End Sub  

Каждый раз, когда запускается эта последовательность, размер файла моей книги с поддержкой макросов увеличивается на несколько килобайт. Это увеличивается в геометрической прогрессии. Как только он достигнет диапазона 30 000 килобайт, моя вторая Рабочая тетрадь (та, которая импортируется во время этого макроса, затем редактируется и сохраняется обратно в исходное местоположение) начинает дублировать столбцы.

1 Ответ

0 голосов
/ 17 января 2020

Это потому, что With ожидает, что объект будет работать (без каламбура), в то время как QueryTable.Refresh не возвращает его.
Для работы .Refresh вам необходимо уже установить соединение.
Я удалил добавление нового соединения из вашего кода и часть очистки. Если вы хотите добавлять новое соединение каждый раз, когда открываете книгу, вы должны также удалить ее перед сохранением и закрытием книги, но я не рекомендую делать это, потому что файлы Excel имеют тенденцию разрываться таким образом с течением времени.

Sub DeleteDuplicateData()  
'  
' DeleteDuplicateData Macro
'  
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False  
    ActiveSheet.QueryTables(1).Refresh BackgroundQuery:=False
    Application.CalculateUntilAsyncQueriesDone
    ActiveSheet.Range("$A$1:$Q$2500").RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17), Header:=xlYes  
    ThisWorkbook.SaveAs Filename:="C:\Users\techadmin\Documents\Sapphire Report Agent\Sapphire_NK_Export", FileFormat:=xlCSV, CreateBackup:=False
    ' I assume A1 to be the ActiveCell, but it's still referring to the ActiveSheet
    Range("A1").FormulaR1C1 = "STATE_STUDENT_ID"
    ThisWorkbook.SaveAs Filename:="C:\Users\techadmin\Documents\DeleteDuplicateDataMacro\DeleteDuplicateDataMacro", FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

Пожалуйста, посмотрите на этот вопрос еще раз, чтобы понять, как избежать использования Select, Activate и неявных ссылок ActiveSheet.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...