Мой код работает довольно быстро.Я решил использовать FSO, так как я буду открывать и читать несколько больших файлов во время выполнения этого кода.Мой код уже работает довольно быстро, но мне интересно, что я мог бы сделать, чтобы улучшить его.
Я уже выключил обновление экрана, кроме включения ручных вычислений (не входит в сферу этого проекта), чтоя мог сделать?
Row = 2
On Error GoTo ErrHandler
'Paths
serverPath = "\\kingnet\public\reports\"
'Files
lcaseReport = "Slbs_a01.txt"
dcaseReport = "Dlbs_a01.txt"
Application.ScreenUpdating = False
With Sheet2
Do While .Cells(Row, 3) <> ""
If (Cells(Row, 7)) = Date Then
filePath = serverPath
ElseIf (Cells(Row, 7)) < Date Then
filePath = serverPath & "archive\" & Format(.Cells(Row, 7), "mmddyyyy") & "\"
ElseIf (Cells(Row, 7)) = "" Then
GoTo Skip
End If
If .Cells(Row, 8) = "" Then
Set fsoStream = FSO.OpenTextFile(filePath & lcaseReport, ForReading)
Do While fsoStream.AtEndOfStream <> True
strLine = fsoStream.ReadLine
carton = Mid(strLine, 10, 16)
'lcase First Label
If carton = .Cells(Row, 3).Value = True Then
.Cells(Row, 8).Value = Mid(strLine, 31, 5)
.Cells(Row, 11).Value = Mid(strLine, 41, 5)
.Cells(Row, 13).Value = "lcase"
End If
'lcase Last Label
If carton = .Cells(Row, 4).Value = True Then
.Cells(Row, 8).Value = Mid(strLine, 31, 5)
.Cells(Row, 12).Value = Mid(strLine, 41, 5)
.Cells(Row, 14).Value = .Cells(Row, 12).Value - .Cells(Row, 11).Value
End If
Loop
fsoStream.Close
Set FSO = Nothing
End If
Skip:
Row = Row + 1
Loop
End With
'dcase
Row = 2
With Sheet2
Do While .Cells(Row, 3) <> ""
If (Cells(Row, 7)) = Date Then
filePath = serverPath
ElseIf (Cells(Row, 7)) < Date Then
filePath = serverPath & "archive\" & Format(.Cells(Row, 7), "mmddyyyy") & "\"
Else
GoTo Skip2
End If
If .Cells(Row, 13) = "" Then
Set fsoStream = FSO.OpenTextFile(filePath & dcaseReport, ForReading)
Do While fsoStream.AtEndOfStream <> True
strLine = fsoStream.ReadLine
carton = Mid(strLine, 10, 16)
'dcase First Label
If carton = .Cells(Row, 3).Value = True Then
.Cells(Row, 8).Value = Mid(strLine, 31, 5)
.Cells(Row, 11).Value = Mid(strLine, 41, 5)
.Cells(Row, 13).Value = "dcase"
End If
'dcase Last Label
If carton = .Cells(Row, 3).Value = True Then
.Cells(Row, 8).Value = Mid(strLine, 31, 5)
.Cells(Row, 12).Value = Mid(strLine, 41, 5)
.Cells(Row, 14).Value = .Cells(Row, 12).Value - .Cells(Row, 11).Value
End If
Loop
fsoStream.Close
Set FSO = Nothing
End If
Skip2:
Row = Row + 1
Loop
End With
Application.ScreenUpdating = True
Exit Sub
ErrHandler:
Select Case Err.Number
Case 76
MsgBox "Archive folder for date " & (Cells(Row, 7)) & " on row number " & Row & " missing. Contact Server Ops. To skip this line click ignore.", vbAbortRetryIgnore + vbDefaultButton3
Resume Skip
Case 53
MsgBox "File missing from " & filePath & ". Files may be archived, run again after midnight or contact Server Ops.", vbAbortRetryIgnore + vbDefaultButton3
Resume Skip
End Select