У меня есть приложение Excel, которое часто, но не всегда, вылетает при нормальной работе. Если вы установили точку останова и пошагово выполняли программу, она никогда не завершится ошибкой. Точно так же, если вы устанавливаете контрольные точки в стратегических местах, а затем продолжаете их выполнять, как правило, также хорошо работает.
Похоже, что проблема связана с открытием файла, копированием большого объема данных и последующим закрытием файла. Я, однако, не уверен, где программа на самом деле падает. Советы по отладке / методы поиска места, где происходит ошибка в коде, были бы очень полезны.
Я предположил, что это связано с состоянием гонки или проблемами с памятью, но точно не знаю, что может вызвать любую из этих ошибок. Тем не менее, состояние гонки кажется более вероятным, поскольку приостановка или прохождение приложения не должно помочь с проблемами памяти. Если причиной проблемы является состояние гонки, есть ли лучшее решение, чем дать приложению спать / ждать в определенных точках? Как определить точки, где мне нужно было бы спать / ждать?
РЕДАКТИРОВАТЬ: при нормальном запуске приложения кажется, что оно работает дольше, чем вы ожидаете, а затем просто закрывается без каких-либо сообщений об ошибках. Я использую Excel 2013 (32 бита) на Win 10.
Я посчитал проблему сохранением данных на cliboard и добавил
Application.CutCopyMode = False
после каждой вставки, это не решило проблему.
Я подавляю предупреждения и обновление экрана, т.е.
Application.DisplayAlerts = False
Application.ScreenUpdating = False
, но комментируя эти настройки, все равно вызывает сбой приложения.
EDIT2: добавление кода, в котором происходит сбой. Похоже, что где-то в ReadInAndCopyFiles происходят ошибки.
Sub ReadInFiles(wb As Workbook, FolderPath As String, FileName As String)
Dim CurrentWeekDate As Date
Dim TempDate As Date
Dim TempFilePath As String
Dim DataFileName As String
Dim OpenDialog As Office.FileDialog
Dim DateString As String
Dim SheetNameArray As Variant
'Initialization
CurrentWeekDate = wb.Worksheets("Config").Range("EndOfWeekDate").Value
ChDir (FolderPath)
If FileName = "Weekly utilization" Then
SheetNameArray = Array("WeeklyUtilization_CW", "WeeklyUtilization_CW-1", "WeeklyUtilization_CW-2", "WeeklyUtilization_CW-3")
Else
SheetNameArray = Array("Charged Hours", "ChargedHours_CW-1", "ChargedHours_CW-2", "ChargedHours_CW-3")
End If
'Current Week
TempFilePath = FolderPath + FileName + ".xlsx"
ReadInAndCopyFile TempFilePath, CStr(SheetNameArray(0)), "Find " & FileName
'Current Week -1
TempDate = DateAdd("d", -7, CurrentWeekDate)
DateString = Format(TempDate, "yy-mm-dd")
TempFilePath = FolderPath + "Archives\" + FileName + " " + DateString + ".xlsx"
ReadInAndCopyFile TempFilePath, CStr(SheetNameArray(1)), "Find " & FileName & " -1"
'Current Week -2
TempDate = DateAdd("d", -14, CurrentWeekDate)
DateString = Format(TempDate, "yy-mm-dd")
TempFilePath = FolderPath + "Archives\" + FileName + " " + DateString + ".xlsx"
ReadInAndCopyFile TempFilePath, CStr(SheetNameArray(2)), "Find " & FileName & " -2"
'Current Week -3
TempDate = DateAdd("d", -21, CurrentWeekDate)
DateString = Format(TempDate, "yy-mm-dd")
TempFilePath = FolderPath + "Archives\" + FileName + " " + DateString + ".xlsx"
ReadInAndCopyFile TempFilePath, CStr(SheetNameArray(3)), "Find " & FileName & " -3"
End Sub
Sub ReadInAndCopyFile(TempFilePath As String, TargetSheetName As String, CustomMessage As String)
Dim DataFileName As String
Dim SourceWb, wb As Workbook
Dim ws As Worksheet
Dim LastRow, LastColumn, StartRow, TargetLastRow As Variant
Dim OpenDialog As Office.FileDialog
Set wb = ActiveWorkbook
DataFileName = Dir(TempFilePath)
If Not DataFileName <> "" Then
MsgBox CustomMessage
Set OpenDialog = Application.FileDialog(msoFileDialogFilePicker)
OpenDialog.Filters.Clear
OpenDialog.Filters.Add "Excel Files", "*.xlsx"
OpenDialog.AllowMultiSelect = False
OpenDialog.Show
TempFilePath = OpenDialog.SelectedItems(1)
End If
Workbooks.Open FileName:=TempFilePath, UpdateLinks:=False
Set SourceWb = ActiveWorkbook
'Determine where to start pasting, and if header should be included or not
If (wb.Worksheets(TargetSheetName).Cells(Rows.Count, 1).End(xlUp).Row = 1) Then
StartRow = 1
Else
StartRow = wb.Worksheets(TargetSheetName).Cells(Rows.Count, 1).End(xlUp).Row + 1
End If
'Copy First Sheet
LastRow = SourceWb.Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
'Dont copy any data if blank
If LastRow <> 1 Then
LastColumn = SourceWb.Worksheets("Sheet1").Cells(1, Columns.Count).End(xlToLeft).Column
If StartRow = 1 Then
Range(SourceWb.Worksheets("Sheet1").Cells(1, 1), SourceWb.Worksheets("Sheet1").Cells(LastRow, LastColumn)).Copy
Else
Range(SourceWb.Worksheets("Sheet1").Cells(2, 1), SourceWb.Worksheets("Sheet1").Cells(LastRow, LastColumn)).Copy
End If
wb.Worksheets(TargetSheetName).Range("A" + CStr(StartRow)).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
TargetLastRow = wb.Worksheets(TargetSheetName).Cells(Rows.Count, 1).End(xlUp).Row
End If
'Copy Second Sheet
LastRow = SourceWb.Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
'Dont copy any data if blank
If LastRow <> 1 Then
LastColumn = SourceWb.Worksheets("Sheet2").Cells(1, Columns.Count).End(xlToLeft).Column
'Copy from row 2 to avoid copying headers again
Range(SourceWb.Worksheets("Sheet2").Cells(2, 1), SourceWb.Worksheets("Sheet2").Cells(LastRow, LastColumn)).Copy
wb.Worksheets(TargetSheetName).Range("A" + CStr(TargetLastRow + 1)).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End If
SourceWb.Close SaveChanges:=False
End Sub