У меня есть макрос, который извлекает некоторые данные из внешнего источника, а затем создает файл CSV, содержащий данные. Затем он проверяет, являются ли это самые последние данные, и, если нет, повторяет вышеупомянутое.
Обычно это работает нормально, но если есть большой объем данных, подлежащих обработке, я заметил, что он иногда пропускает файл здесь и там.
Я пытался включить ведение журнала, чтобы проверить, происходит ли что-то не так, но, похоже, это не так. В журнале даже записывается создание отсутствующих файлов.
Из того, что я прочитал, VBA не работает асинхронно. Так что же происходит? Как мне точно определить проблему и что я могу с этим сделать?
РЕДАКТИРОВАТЬ: проблема оказалась довольно глупой. Поскольку файлы именуются с использованием текущего времени, которое является точным только с точностью до секунды, некоторые файлы создавались в течение одной секунды и, следовательно, перезаписывали друг друга. Я изменил формат именования файлов.
Спасибо, что указали на то, что я неправильно использовал обработку ошибок (или ее отсутствие).
Мой код:
Option Explicit
Public DebugMode As Boolean
Public TestMode As Boolean
Private Sub Workbook_Open()
Dim piServer As PISDK.Server
Dim connection As Boolean
Dim connectionTries As Integer
Dim dataTime As Date
Dim currentTime As Date
Dim rowNo As Integer
'Set to True to enable logging to debug.txt
DebugMode = True
'Set to True to write output only to Test Output folder
TestMode = False
WriteLogs ("Successfully opened GCS_Handoff.xls")
Set piServer = PISDK.Servers(Range("piServer").Value)
connection = False
connectionTries = 0
PI_Reconnect:
'If PI Server is not connected...
If Not piServer.Connected Then
WriteLogs ("Connecting to PI Server at " & Range("piServer").Value & "...")
On Error Resume Next
Err.Clear
'Connect to PI Server
'Call piServer.Open("UID=" & "piadmin" & ";PWD=" & "password")
Call piServer.Open
'If connection attempt to PI Server was not successful..
If Err.Number <> 0 Then
'Pause for 20 seconds
Application.Wait DateAdd("s", 20, Now)
'Increment count
connectionTries = connectionTries + 1
'Retry 5 times
If connectionTries <= 5 Then
GoTo PI_Reconnect:
Else
'5th attempt failed... quit Excel
WriteLogs ("Failed to connect to PI")
GoTo Exit_App:
End If
End If
WriteLogs ("Successfully connected to PI")
End If
dataTime = Range("DataTime").Value
'Current time round to nearest half hour
currentTime = Round(Now() * 48, 0) / 48
'Repeat the following until current time reached
Do While dataTime < currentTime
'Increment the data time by 30 minutes
dataTime = DateAdd("n", 30, dataTime)
WriteLogs ("Starting " & dataTime)
'The row containing the first tag
rowNo = 2
'While there is a value in column A of the current row
Do While IsEmpty(Sheets("Data").Range("A" & rowNo).Value) = False
'Clear the previous data
Sheets("Data").Range(Cells(rowNo, 2), Cells(rowNo, 3)).ClearContents
'Read the tag in column A and write the PI value in column C
Sheets("Data").Range(Cells(rowNo, 2), Cells(rowNo, 3)) = _
Application.Run("PIArcVal", Sheets("Data").Range("A" & rowNo).Value, dataTime, 1, piServer, "auto")
rowNo = rowNo + 1
Loop
'Update the last data write timestamp
Range("DataTime").Value = dataTime
WriteLogs ("Successfully retrieved PI data in GCS_Handoff.xls")
'Write to CSV
Call WriteToCSV(dataTime, rowNo)
Loop
Exit_App:
'Cleanup...
Set piServer = Nothing
'Stop alerts
'Close workbook (and Excel if no other workbooks are open)
If Workbooks.Count > 1 Then
WriteLogs ("Multiple workbooks open. Closing GCS_Handoff.xls...")
Application.DisplayAlerts = False
ThisWorkbook.Close True
WriteLogs ("Successfully closed GCS_Handoff.xls")
Else
WriteLogs ("Quitting Excel...")
Application.DisplayAlerts = False
Application.Quit
WriteLogs ("Successfully quit Excel")
End If
End Sub
Sub WriteToCSV(ByVal timeStamp, ByVal emptyRow)
Dim fso As FileSystemObject
Dim fileTime As String
Dim outputFile As File
Dim outputPath As String
Dim txtStream As TextStream
Dim i As Integer
Dim line As String
Set fso = New FileSystemObject
'In Test Mode, write the file to the Test folder
If TestMode = True Then
outputPath = Range("ApplicationPath").Value & "Test Output\"
Else
outputPath = Range("ApplicationPath").Value & "Output\"
End If
On Error Resume Next
fileTime = Format(Now, "yyyy-MM-dd_hh-mm-ss")
WriteLogs ("Creating CSV file...")
'Create the output CSV file
Set outputFile = fso.CreateTextFile(outputPath & "GCS_PI_" & fileTime & ".csv")
WriteLogs ("CSV file created")
Set outputFile = fso.GetFile(outputPath & "GCS_PI_" & fileTime & ".csv")
Set txtStream = outputFile.OpenAsTextStream(ForWriting)
WriteLogs ("Writing CSV file...")
'Loop through the data cells and write each one on a new line
With txtStream
.WriteLine timeStamp
For i = 2 To emptyRow - 1
line = Sheets("Data").Range("A" & i).Value & "," & Sheets("Data").Range("C" & i).Value
If i < emptyRow - 1 Then
'Write the line and a line return character
.WriteLine (line)
Else
'If this is the final line
.Write (line)
End If
Next
.Close
End With
WriteLogs ("CSV file written")
WriteLogs ("Finishing " & timeStamp)
'Cleanup...
Set fso = Nothing
Set outputFile = Nothing
Set txtStream = Nothing
End Sub
Sub WriteLogs(ByVal logText)
Dim fso As FileSystemObject
Dim logFile As File
Dim txtStream As TextStream
Dim logPath As String
'If running in Debug Mode
If DebugMode = True Then
Set fso = New FileSystemObject
logPath = Range("ApplicationPath").Value & "Logs\"
On Error Resume Next
'Get the log file
Set logFile = fso.GetFile(logPath & "debug.txt")
'If the file doesn't exist, create it
If Err <> 0 Then
Set logFile = fso.CreateTextFile(logPath & "debug.txt")
Set logFile = fso.GetFile(logPath & "debug.txt")
End If
Set txtStream = logFile.OpenAsTextStream(ForAppending)
'Write the current time and the log text
With txtStream
.WriteLine Now() & " " & logText
.Close
End With
'Cleanup...
Set fso = Nothing
Set logFile = Nothing
Set txtStream = Nothing
End If
End Sub