Очистка памяти или файлов после открытия с помощью макроса - PullRequest
0 голосов
/ 29 мая 2020

У меня есть макрос VBA, который открывает файлы в папке, загружает данные из надстройки, сохраняет и закрывает. Это работает нормально, но после 10 или 15 файлов становится довольно медленно. Я думаю, это потому, что Excel все еще хранит в памяти ранее открытые файлы. Я знал это, потому что видел уже открытые и закрытые файлы на левой панели, как на фото ниже. (фотография показывает, где находится панель, я знаю, что с листами открыт только один файл, но вы понимаете, о чем я).

Мой вопрос: есть ли строка кода, которая обновляется sh или очистить эту временную память?

Вот мой код:

'PURPOSE: To loop through all Excel files in a user specified folder and perform a set task on them

Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim filename As String
Dim path_to_save As String
Dim FldrPicker As FileDialog
Dim w As Long
Dim StartTime As Double
Dim SecondsElapsed As Double
Dim oFile       As Object
Dim oFSO        As Object
Dim oFolder     As Object
Dim oFiles      As Object


Application.ScreenUpdating = False
StartTime = Timer

'Retrieve Target Folder Path From User
  Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
    With FldrPicker
      .Title = "Select A Target Folder"
      .AllowMultiSelect = False
        If .Show <> -1 Then GoTo NextCode
        myPath = .SelectedItems(1) & "\"
    End With

'In Case of Cancel
NextCode:
  myPath = myPath
  If myPath = "" Then GoTo ResetSettings

'Assign the folder to oFSO
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set oFolder = oFSO.GetFolder(myPath)
    Set oFiles = oFolder.Files
    If oFiles.Count = 0 Then GoTo ResetSettings


For Each oFile In oFolder.Files
    'Set variable equal to opened workbook
    myFile = oFile.Name
    Set wb = Workbooks.Open(filename:=myPath & myFile)
    Set cmd = Application.CommandBars("Cell").Controls("Refresh All")
    cmd.Execute
    DoEvents

    'Ensure Workbook has opened before moving on to next line of code

    wb.Close savechanges:=True


    'Ensure Workbook has closed before moving on to next line of code
    DoEvents
Next 'oFile

SecondsElapsed = Timer - StartTime
MsgBox "This code ran successfully in " & SecondsElapsed
    Set oFile = Nothing
    Set oFolder = Nothing
    Set oFSO = Nothing

ResetSettings:
  'Reset Macro Optimization Settings
    Application.ScreenUpdating = True
End Sub

enter image description here

Ответы [ 2 ]

0 голосов
/ 01 июня 2020

В Excel существует известная проблема с закрытыми книгами, оставляющими данные в памяти, которую можно очистить только путем закрытия и повторного открытия Excel.

В приведенном ниже коде используется второй экземпляр приложения Excel с поздней привязкой, в попытке облегчить эту проблему; второй экземпляр будет периодически закрываться и открываться повторно (в настоящее время установлено каждые 5 файлов).

Sub SomeName()
    'PURPOSE: To loop through all Excel files in a user specified folder and perform a set task on them

    Dim wb As Workbook
    Dim myPath As String
    Dim myFile As String
    Dim myExtension As String
    Dim filename As String
    Dim path_to_save As String
    Dim FldrPicker As FileDialog
    Dim w As Long
    Dim StartTime As Double
    Dim SecondsElapsed As Double
    Dim oFile       As Object
    Dim oFSO        As Object
    Dim oFolder     As Object
    Dim oFiles      As Object

    'NEW CODE
    Dim appXL AS Object, counterFiles AS Long
    counterFiles = 0

    Application.ScreenUpdating = False
    StartTime = Timer

    'Retrieve Target Folder Path From User
    Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
    With FldrPicker
    .Title = "Select A Target Folder"
        .AllowMultiSelect = False
        If .Show <> -1 Then GoTo NextCode
        myPath = .SelectedItems(1) & "\"
    End With

    'In Case of Cancel
    NextCode:
    myPath = myPath
    If myPath = "" Then GoTo ResetSettings

    'Assign the folder to oFSO
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set oFolder = oFSO.GetFolder(myPath)
    Set oFiles = oFolder.Files
    If oFiles.Count = 0 Then GoTo ResetSettings


    For Each oFile In oFolder.Files
        'NEW CODE
        If appXL Is Nothing Then Set appNewExcel = CreateObject("Excel.Application")
        DoEvents

        'Set variable equal to opened workbook
        myFile = oFile.Name
        Set wb = appNewExcel.Workbooks.Open(filename:=myPath & myFile)

        'Update / Refresh workbook
        wb.RefreshAll
        appNewExcel.CalculateFullRebuild
        DoEvents

        'Ensure Workbook has opened before moving on to next line of code
        wb.Save
        DoEvents
        wb.Close savechanges:=True


        'Ensure Workbook has closed before moving on to next line of code
        'NEW CODE
        Set wb = Nothing
        counterFiles = counterFiles+1
        If counterFiles mod 5 = 0 Then
            appNewExcel.Quit
            Set appNewExcel = Nothing
        End If

        DoEvents
    Next 'oFile

    SecondsElapsed = Timer - StartTime
    MsgBox "This code ran successfully in " & SecondsElapsed

    Set oFile = Nothing
    Set oFolder = Nothing
    Set oFSO = Nothing

ResetSettings:
    'Reset Macro Optimization Settings
    Application.ScreenUpdating = True
End Sub
0 голосов
/ 29 мая 2020

А как насчет добавления:

set cmd = nothing

перед

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