我對以下代碼有疑問，它應該順序打開?100個csv檔案，檢查單元格中的值（驗證，如果它是具有正確結構的檔案），復制單行資料并將其粘貼到ThisWorkbook.Worksheets("2 CSV").Range("B" & row_number).
這個解決方案作業了兩年，直到本月。現在整個 Excel 在任何檔案上隨機崩潰，沒有任何錯誤訊息。有時它會設法遍歷 20 個檔案，有時是 5 個。
最奇怪的是，我可以F8毫無問題地手動回圈使用整個內容。
宏：
Sub b_load_csv()
Dim appStatus As Variant
Dim folder_path As String 'folder path to where CSVs are stored
Dim file_name As String 'file name of current CSV file
Dim row_number As Integer 'row number in target sheet
Dim source_sheet_name As String 'name of the source sheet of the CSV = CSV file name
Dim wb_src As Workbook 'variable for opened CSV source workbook
Dim sht_src As Worksheet 'variable for opened CSV source sheet
Dim sht_csv As Worksheet 'variable for target sheet in ThisWorkbook
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
.DisplayAlerts = False
If .StatusBar = False Then appStatus = False Else appStatus = .StatusBar 'show currently processing file in status bar
End With
folder_path = "C:\Folder\SubFolder\" 'here are the files stored
file_name = Dir(folder_path & "*.csv") 'using dir to get file names
row_number = 3 'row number for pasting values
Set sht_csv = ThisWorkbook.Worksheets("2 CSV") 'target sheet for data aggregation
Do While file_name <> ""
Workbooks.Open (folder_path & file_name), UpdateLinks:=False, Local:=True 'open csv file
Set wb_src = Workbooks(file_name) 'assign opened csv file to variable
source_sheet_name = Left(file_name, InStr(file_name, ".") - 1) 'sheet name in csv is the same as the file name
Set sht_src = wb_src.Worksheets(source_sheet_name) 'assign source sheet to variable
If sht_src.Range("C1").Value2 = "OJ_POPIS" Then 'checks if the csv has the correct structure
sht_src.Range("A2:FZ2").Copy 'if so copies desired range
sht_csv.Range("B" & row_number).PasteSpecial 'and pastes it into target worksheet column B
End If
sht_csv.Range("A" & row_number).Value2 = file_name 'writes file name into column A
Application.CutCopyMode = False
wb_src.Close SaveChanges:=False
file_name = Dir() 'fetch next file name
row_number = row_number 1
'the following lines is what I tried to fix the problem of random excel crashing
Set wb_src = Nothing
Set sht_src = Nothing
Application.StatusBar = "Processing file " & file_name
DoEvents
Application.Wait (Now TimeValue("0:00:02"))
ThisWorkbook.Save 'save after every loaded file to see which files are causing the problem
Loop
MsgBox "Data from CSV files copied", vbOKOnly
Set sht_csv = Nothing
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
源 CSV 檔案在UTF-8和ANSI（我的 ACP 是ANSI, 1250）中編碼并;分隔。
組策略限制宏不適用于我。我可以簽署自己的宏。
我嘗試了什么：
- 回圈結束時的代碼行
- 識別和洗掉觸發崩潰的檔案（它們沒有任何共同點，看似隨機，當洗掉其中的一半時......有什么意義）
- 簡化宏
- 新作業簿
- 不同的機器
- VPN 開/關
謝謝您的幫助！
uj5u.com熱心網友回復：
我要嘗試的第一件事是包含一個適當的錯誤處理程式（下一個不恢復），特別是對于 x64，并確保在工具/選項/常規中選擇“中斷所有未處理的錯誤”。
我要嘗試的第二件事是避免使用剪貼板 -
With sht_src.Range("A2:FZ2")
sht_cvs.Range("B" & row_number).Resize(.Rows.Count, .Columns.Count).Value = .Value
End With
（無需清除 CutCopyMode）
我要嘗試的第三件事是不要用 Dir 過濾，而是像這樣 -
sFilter = "*.cvs"
file_name = Dir$(, 15) ' without vbDirectory if not getting subfolders
Do While Len(file_name)
If file_name Like sFilter Then
' process file
End If
file_name = Dir$(, 15)
Loop
我要嘗試的第四件事是一杯好咖啡！
轉載請註明出處，本文鏈接：https://www.uj5u.com/ruanti/443919.html