Подозреваю, что в коде где-то что-то концептуально неправильно, из-за чего может утекать память.
Для импорта в акцесс обрабатываю предварительно кучу экселек таким кодом:
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
Dim xla
Sub RunProcessingXlk()
'Используем ФСО для возврата всех файлов в выбранной папке
'идем циклом по файлу, получаем его имя и далее работаем с рабочей книгой с этим именем
Dim fso, fld, f1, fc, s
Dim FolderSpec
Dim d1, d2
Dim lng_FileCount As Long
lng_FileCount = 0
d1 = Now
'CHANGE FOLDER===========================================================================
FolderSpec = "d:\docs\КировгрОтчеты\ТестОбрДолжн\"
'========================================================================================
Set fso = CreateObject("Scripting.FileSystemObject")
Set fld = fso.GetFolder(FolderSpec)
Set fc = fld.Files
For Each f1 In fc
If lng_FileCount > 0 Then
Set xla = GetObject(, "Excel.Application")
Else
Set xla = New Excel.Application
End If
xla.ScreenUpdating = False
s = f1.Name: lng_FileCount = lng_FileCount + 1
OneXlsWBProcessing s, FolderSpec
Next f1
xla.ScreenUpdating = True
Set xla = Nothing
d2 = Now
MsgBox "Ура, ура! Обработка кучи экселек завершена", vbInformation, "satart at " & d1 & " end at " & d2
End Sub
Ничего вроде не придумывал, взял свой работающий код 2летней давности и немножко допилил. Есть что-то концептуально неправильное, из-за чего память может утекать?
Обработка может быть примерно такой:
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
Sub OneXlsWBProcessing(WBFileName, FolderSpec)
'Обработка единственного эксельного файла
Dim xlw, xls
Dim strStartCell As String, stryyyymm01 As String
strStartCell = "A1"
Set xlw = xla.Workbooks.Open(FolderSpec & WBFileName)
' xla.Visible = False
Set xls = xlw.ActiveSheet
Dim lng_row_count As Long, lng_col_count As Long
With xls
.Columns("A:A").Delete Shift:=xlToLeft
.Rows("1:3").Delete Shift:=xlUp
.Rows("2:2").Delete Shift:=xlUp
lng_row_count = .Range(strStartCell).CurrentRegion.Rows.Count
lng_col_count = .Range(strStartCell).CurrentRegion.Columns.Count
.Rows(lng_row_count).Delete Shift:=xlUp
.Cells(1, lng_col_count + 1) = "Расчетный период"
stryyyymm01 = Left(WBFileName, 6) & "01"
.Cells(2, lng_col_count + 1).FormulaR1C1 = stryyyymm01
.Cells(2, lng_col_count + 1).AutoFill Destination:=.Range(.Cells(2, lng_col_count + 1), .Cells(lng_row_count - 1, lng_col_count + 1))
End With
xlw.Names.Add "Data0", xlw.Sheets(1).Range(strStartCell).CurrentRegion
xlw.Close SaveChanges:=True
Set xls = Nothing
Set xlw = Nothing
End Sub
