Почему обрывается работа макроса в Excel?

Question

[ti_zh_vrach]

Добрый день!
Поиски ответа на русском языке не дали результата. Поиски на английском не дали результата наверное в силу плохого знания языка. Дальше 40-й строки в поисковой выдаче не смотрел.

Работа макроса обрывается в любой момент времени (или не обрывается) без каких-либо сообщений об ошибках на одном и том же участке кода. Проблема наблюдается и на 32-битной, и на 64-битной (со слов конечного пользователя) версиях Excel 2016.

Макрос берёт данные из файла, обогащает через запрос с сервера, распиливает на 200-250 маленьких файлов xlsx, параллельно пишет в два сводных файла и отправляет всё получателям. Проблема всегда возникает во время распила на файлы.

Код такой:

Option Explicit
Sub macros_name()

Dim c As Integer
Dim i, j, o As Long
Dim some_code, small_file, file_total_data, created_file As String
Dim FSO, work_folder, work_file, dict_target, dict_another As Object
Dim l_inc_data, l_out As Workbook
'Как я узнал тут (https://qna.habr.com/q/1071426), _
часть переменных объявлена как Variant из-за перечисления через запятую.

Application.DisplayStatusBar = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
ActiveSheet.DisplayPageBreaks = False

Set FSO = CreateObject("Scripting.FileSystemObject")
Set work_folder = FSO.GetFolder(ThisWorkbook.Path)

On Error Resume Next
If l_input.AutoFilterMode Then l_input.ShowAllData
If l_main.AutoFilterMode Then l_main.ShowAllData
If l_data.AutoFilterMode Then l_data.ShowAllData
On Error GoTo 0

'Здесь забираются данные из файла. 10 колонок и около 2000 строк. Здесь всегда всё хорошо.

If Len(l_input.Cells(2, 1).Value) > 0 Then
    j = l_main.Cells(l_main.Rows.Count, 1).End(xlUp).Row + 1
    For i = 2 To l_input.Cells(l_input.Rows.Count, 1).End(xlUp).Row
        l_main.Cells(j, 8).NumberFormat = "@"
        l_main.Cells(j, 11).NumberFormat = "@"

        For c = 1 To 10
           l_main.Cells(j, c).Value = l_input.Cells(i, c).Value
        Next c
        
        some_code = add_data(args) 'тут функцию менял на ГСЧ - без толку.
        l_main.Cells(j, 11).Value = some_code
        If Len(l_main.Cells(j, 11).Value) > 0 _
        And dict_target(l_main.Cells(j, 11).Value) <> "no data" Then
            l_main.Cells(j, 12).Value = dict_another.Item(l_main.Cells(j, 11).Value)
            small_file = ThisWorkbook.Path & "\part_of_name" & some_code & " " & Date & ".xlsx"
            file_total_data = ThisWorkbook.Path & "\part_of_name" & l_main.Cells(j, 12).Value & " " _
                                      & Date & ".xlsx"
            'crate_new_file создаёт новый файл xlsx, делает заголовки колонок и закрывает файл.
            If Not FSO.FileExists(small_file) Then Call crate_new_file(small_file, False, row_log)
            If Not FSO.FileExists(file_total_data) Then Call crate_new_file(file_total_data, True, row_log)
            
            Set l_out = Application.Workbooks.Open(Filename:=small_file)
            o = l_out.Sheets(1).Cells(l_out.Sheets(1).Rows.Count, 1).End(xlUp).Row + 1
            
            For c = 1 To 10
                l_out.Sheets(1).Cells(o, c).Value = l_input.Cells(i, c).Value
            Next c
            
            l_out.Close True
            
            Set l_out = Application.Workbooks.Open(Filename:=file_total_data)
            o = l_out.Sheets(1).Cells(l_out.Sheets(1).Rows.Count, 1).End(xlUp).Row + 1
            
            For c = 1 To 10
                l_out.Sheets(1).Cells(o, c).Value = l_input.Cells(i, c).Value
            Next c
            
            l_out.Close True
        End If
        j = j + 1
    Next i
End If

'Здесь макрос делает остальные задачи. Тут тоже всегда всё хорошо.
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayStatusBar = True

End Sub

Что пробовал: замену обогащающей функции на генератор случайных чисел (см. код), и перенос данных из файла в файл с помощью массивов.

В последнем случае проблемный участок выглядит так:

....
Dim cells_to_copy As Range
....
If Len(l_input.Cells(2, 1).Value) > 0 Then
    j = l_main.Cells(l_main.Rows.Count, 1).End(xlUp).Row + 1
    For i = 2 To l_input.Cells(l_input.Rows.Count, 1).End(xlUp).Row
        l_main.Cells(j, 8).NumberFormat = "@"
        l_main.Cells(j, 11).NumberFormat = "@"

        Set cells_to_copy = l_input.Range(l_input.Cells(i, 1), l_input.Cells(i, 10))
        l_main.Range(l_main.Cells(j, 1), l_main.Cells(j, 10)).Value = cells_to_copy.Value

        some_code = add_data(args) 'тут функцию менял на ГСЧ - без толку.
        l_main.Cells(j, 11).Value = some_code
        If Len(l_main.Cells(j, 11).Value) > 0 _
        And dict_target(l_main.Cells(j, 11).Value) <> "no data" Then
            l_main.Cells(j, 12).Value = dict_another.Item(l_main.Cells(j, 11).Value)
            small_file = ThisWorkbook.Path & "\part_of_name" & some_code & " " & Date & ".xlsx"
            file_total_data = ThisWorkbook.Path & "\part_of_name" & l_main.Cells(j, 12).Value & " " _
                                      & Date & ".xlsx"
            If Not FSO.FileExists(small_file) Then Call crate_new_file(small_file, False, row_log)
            If Not FSO.FileExists(file_total_data) Then Call crate_new_file(file_total_data, True, row_log)
            
            Set l_out = Application.Workbooks.Open(Filename:=small_file)
            o = l_out.Sheets(1).Cells(l_out.Sheets(1).Rows.Count, 1).End(xlUp).Row + 1
            
            output_data.Sheets(1).Range( _
                              output_data.Sheets(1).Cells(current_row, 1), output_data.Sheets(1).Cells(current_row, output_data.Sheets(1).Cells(1, Columns.Count).End(xlToLeft).Column) _
                              ).NumberFormat = "@"
            output_data.Sheets(1).Range( _
                              output_data.Sheets(1).Cells(current_row, 1), output_data.Sheets(1).Cells(current_row, output_data.Sheets(1).Cells(1, Columns.Count).End(xlToLeft).Column) _
                              ).Value = copied_data.Value
            
            l_out.Close True
            Set l_out = Nothing
            
            Set l_out = Application.Workbooks.Open(Filename:=file_total_data)
            o = l_out.Sheets(1).Cells(l_out.Sheets(1).Rows.Count, 1).End(xlUp).Row + 1
            
            output_data.Sheets(1).Range( _
                              output_data.Sheets(1).Cells(current_row, 1), output_data.Sheets(1).Cells(current_row, output_data.Sheets(1).Cells(1, Columns.Count).End(xlToLeft).Column) _
                              ).NumberFormat = "@"
            output_data.Sheets(1).Range( _
                              output_data.Sheets(1).Cells(current_row, 1), output_data.Sheets(1).Cells(current_row, output_data.Sheets(1).Cells(1, Columns.Count).End(xlToLeft).Column) _
                              ).Value = copied_data.Value
            
            l_out.Sheets(1).Cells(o, 11).Value = some_code
            l_out.Close True
            Set l_out = Nothing
        End If
        Set cells_to_copy = Nothing
        j = j + 1
    Next i
End If

В обоих случаях Excel (32 бит) работает одинаковое время (если не обрывается) и быстро занимает примерно 600 мб оперативной памяти. После закрытия файла процесс Excel ещё долго висит и медленно сокращает занимаемую оперативную память. Может провисеть час. Так происходит и если прервётся, и если доработает. В случае обрыва всегда остаётся открытым один из маленьких файлов. При этом всегда данные уже записаны на l_main (лист файла с макросом), но ещё не записаны в маленький файл.

В чём может быть проблема и как с этим справиться?

UPD: с Excel x64 проблем с оперативной памятью нет. Обрывы происходят особенно часть, если разговаривать по Skype или смотреть почту в Outlook.

Comments

[Денис _______________]

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

[ti_zh_vrach]

Денис _______________, нет, никаких Activate или Select нету. К почтовику обращается только на этапе отправки. Во время работы оставляю макрос видным на одном мониторе, а сам работаю на другом. Там может быть браузер, PyCharm, почта, что угодно ещё. У конечного пользователя, насколько я знаю, открыт только Excel и всё.

Обновил вопрос, дописал то, что забыл.

[Akina]

Косячный код.
Скажите, откуда будет браться l_xxx.Rows.Count? У книги такого свойства как Rows - тупо нет...

[ti_zh_vrach]

Денис _______________, знаете, я оказался неправ: конечный пользователь сегодня сказал, что обрывы особенно часто происходят, если разговаривать по скайпу или смотреть почту в аутлуке. Я дополню вопрос. Что-то можете тут подсказать?

[ti_zh_vrach]

Akina, Rows - свойство объекта Range, который принадлежит Worksheet. Т.к. в данном случае имеется ввиду Range("A1:XFD1048576"), то его можно опустить и компилятор всё поймёт правильно. Это в моём понимании. Подробнее тут, но я этому источнику уже не доверяю

[Akina]

Rows - свойство объекта Range, который принадлежит Worksheet.

Однако Вы ссылаетесь не на объект Worksheet, а на объект Workbook. У которого Range нет.

его можно опустить и компилятор всё поймёт правильно. Это в моём понимании.

Это в общем случае неверно. И компилятор тут не при чём. Вопрос интерпретации default property в рантайме, которая критичным образом зависит от текущего фокуса.

В общем, указывайте абсолютно корректно - l_xxx.Worksheets("имя листа").Range("диапазон").Rows.Count.

[ti_zh_vrach]

Akina, я понял, на что Вы указываете. Для l_out код поправил.

Это в общем случае неверно. И компилятор тут не при чём. Вопрос интерпретации default property в рантайме, которая критичным образом зависит от текущего фокуса.

Здесь я Вас совсем не понял. Поясните пожалуйста, что Вы имели ввиду?

[Akina]

А что именно непонятно? Вот ссылаетесь Вы на Range, но напрямую через Workbook, у которого Range нет. Где есть Range? у Worksheet. С какого Worksheet будет браться этот Range? Скорее всего, с ActiveSheet... а что будет, если фокус переместится на другой Worksheet? а если не на Worksheet, а на Shape или Form? так что default property может плавать - а за ним и всё остальное.

[ti_zh_vrach]

Akina, именно непонятно было "l_xxx". Т.к. l_out это действительно Workbook. И ошибка очевидно глупая, да. А вот "l_main", который я имел ввиду при ответе - Worksheet. Да, я тут ССЗБ с неймингом, но и Вам бы можно было быть внимательнее и точнее в формулировках.

Теперь у меня к Вам вопрос.

В общем, указывайте абсолютно корректно - l_xxx.Worksheets("имя листа").Range("диапазон").Rows.Count.

Почему нужно указывать Range("диапазон")? Без этого в рантайме может прийти какой-нибудь Range("другой_диапазон")? Или какая-то другая причина? Будет здорово, если кинете в меня ссылкой на почитать про это.

[Akina]

ti_zh_vrach,

Почему нужно указывать Range("диапазон")?

Ну у листа-то тоже есть Rows.Count, верно? не укажешь конкретный Range - получишь свойство для всего листа.

[ti_zh_vrach]

Akina, так свойство для всего листа и нужно. Я уж было подумал, что везде обязательно писать Range("A1:XFD1048576").

А идеи на счёт вопроса есть? Сегодня тестировал с отслеживанием нажатия кнопок. Ничего не поймалось.

Answer 1

[Антон]

В качестве того, что сначала бросилось в глаза
- возможно, ругается на слишком длинные пути вновь создаваемых файлов.
- убрать On Error GoTo 0 и посмотреть, где остановиться.
- добавить DoEvents "случайно" раскидав по коду.
- описать _все_ переменные, возможно, где-то в них появляется что-то неожиданное, Variant довольно коварен.

Comments

[ti_zh_vrach]

Помогло DoEvents. Вставил над открытием файлов. Обрывы во время работы с Outlook прекратились. Да и вообще прекратились. Даже не знаю, где почитать о возможных причинах.