I've automated downloading of CSVs from our vendors' websites. As expected with anything web-based, things can go... wrong, so I'm implementing some better error handling.
The code has been working reasonably stably for a year or so, but when failures have occurred in the download phase, the other phases have attempted to process anyway which is just silly. So now the intent is that archiving the freshly downloaded file and attempting to load it to the appropriate SQL table will only happen if the file is actually freshly downloaded.
So far,I've made some updates to use Err.Raise
when a failure happens at any of the many steps along the way. These are now correctly bubbling up to the main code loop which is dropping into the ErrorHandler:
as expected.
Welcome to the World of Spaghetti™:
What I don't like about how this is shaping up is that the error handler now has a bunch of Resume {label}
code and it feels like I've regressed to 8th grade and am writing some Apple ][ Basic by just GoTo
ing everywhere and even Resum
ing into the middle of a While
loop.
I'm looking for some suggestions on how to refactor ProcessLoad
to better support this method of handling things, or a better solution (that maybe doesn't involve raising errors) for tracking what the current status is and whether subsequent steps should process.
The Dilemma:
The key to my dilemma is that each file download/archive/SQL Load is an independent process. If one fails, there's no reason to abort the whole thing. The load is set up to handle the fact that I might be getting the same CSV file multiple times and to ignore (not load to SQL, though it will attempt to archive it - that's the next thing to fix) any duplicate data in it. I also have the option in my user interface to select all the files that need to be downloaded, or pick and choose just those that I want to download this particular time.
A couple of notes:
- This is existing, functional code that's in the midst of getting a rehab, so things aren't quite as consistent as one might like.
- Yes, I'm aware that I don't handle every error status yet. I don't like how this is shaping up, so I'm looking for input prior to writing more code that has to be changed.
I've declared WebDownloaderStatus as a class to track the current download status:
Option Compare Database
Option Explicit
'@Folder("WebDriver")
Public Enum DownloadStatuses
FailureToCreateDriver = vbObjectError + &H1&
FoundNoSatSurveyClinics = vbObjectError + &H2&
SiteNotLoaded = vbObjectError + &H3&
FailToNavigate = vbObjectError + &H4&
NothingToDownload = vbObjectError + &H5&
DownloadFailed = vbObjectError + &H6&
LoginFailure = vbObjectError + &H7&
OK = 0
End Enum
Private Type TDownloadStatus
companyName As String
downloadType As DownloadDataType
downloadStatus As DownloadStatuses
statusMessage As String
okToContinue As Boolean
End Type
Private this As TDownloadStatus
Public Property Get okToContinue() As Boolean
If downloadStatus >= 0 Then
okToContinue = True
Else
okToContinue = False
End If
End Property
Public Property Get companyName() As String
companyName = this.companyName
End Property
Public Property Let companyName(ByVal value As String)
this.companyName = value
End Property
Public Property Get downloadType() As DownloadDataType
downloadType = this.downloadType
End Property
Public Property Let downloadType(ByVal value As DownloadDataType)
this.downloadType = value
End Property
Public Property Get downloadStatus() As DownloadStatuses
downloadStatus = this.downloadStatus
End Property
Public Property Let downloadStatus(ByVal value As DownloadStatuses)
this.downloadStatus = value
End Property
Public Property Get statusMessage() As String
statusMessage = this.statusMessage
End Property
Public Property Let statusMessage(ByVal value As String)
this.statusMessage = value
End Property
And ProcessLoad is the main driving loop for downloading, archiving and pushing data onto the server:
Public Sub ProcessLoad(ByVal FileType As DownloadDataType, ByVal clinicList As ListBox)
On Error GoTo ErrorHandler
LogManager.Log InfoLevel, "----DataMoveCode.ProcessLoad----------------"
Dim LoadExcelDataRC As Long
Dim Index As Long
Dim DataSources As Scripting.Dictionary
Set DataSources = SetDataSources 'be sure to update this any time IWebDownloader.DownloadDataType changes!
Dim downloaderStatus As WebDownloaderStatus
Set downloaderStatus = New WebDownloaderStatus
Dim Downloader As IWebDownloader
Select Case FileType
Case SnapSurvey
LogManager.Log InfoLevel, "Loading SnapSurvey"
Set Downloader = PrepareForSnapSurveyDownload(downloaderStatus)
Case ApptPlus
LogManager.Log InfoLevel, "Loading ApptPlus"
Set Downloader = PrepareForApptPlusDownload
End Select
Index = 0
While Index < clinicList.ListCount
clinicList.Selected(Index) = True
Select Case FileType
Case SnapSurvey
GetSnapSurveyFile Downloader, clinicList.Column(0, Index), clinicList.Column(1, Index), downloaderStatus
Case ApptPlus
GetApptPlusFile Downloader, clinicList.Column(0, Index), clinicList.Column(1, Index), downloaderStatus
End Select
Dim ArchiveData As ZipToolsData
Dim Archiver As ZipTools
ArchiveSourceDataByClinicID DataSources(FileType), clinicList.Column(0, Index), ArchiveData, Archiver
'todo: Phase 4: give better result reporting so I know if there was an error loading or just no data to be loaded.
LoadExcelDataRC = LoadExcelData(DataSources(FileType), clinicList.Column(0, Index), clinicList.Column(1, Index))
NextClinic:
If LoadExcelDataRC > 0 Then
clinicList.RemoveItem (Index)
Else
clinicList.Selected(Index) = False
Index = Index + 1
End If
Wend
CleanExit:
If Not Downloader Is Nothing Then 'we could get here now without ever having properly set up the downloader class, so skip as necessary
If Downloader.IsLoggedIn Then
Downloader.LogoutOfWebPage
End If
Downloader.Driver.Quit
End If
MassiveAbort:
LogManager.Log InfoLevel, "----DataMoveCode.ProcessLoad Complete----------------"
Exit Sub
ErrorHandler:
With Err
LogManager.Log ErrorLevel, Strings.Join(Array("Source: ", .Source, " Error Num: ", .Number, " Description: ", .Description), vbNullString)
If .Number = FailureToCreateDriver Or .Number = LoginFailure Then
Resume MassiveAbort
ElseIf .Number = NothingToDownload Then
Resume NextClinic
End If
End With
Resume CleanExit
End Sub
It seems I may not have included quite enough code. Here is a path through all methods necessary to initially bring up the web page (prior to logging in) including all the Err.Raise
to send the messages back. (No implication that there are faults with the current review posted - I just want to be sure.)
Public Function GetSnapSurveyFile(ByVal SSWD As IWebDownloader, ByVal clinicID As Integer, ByVal clinicName As String, ByRef webDLStatus As WebDownloaderStatus) As Integer
On Error GoTo ErrorHandler
LogManager.Log InfoLevel, "GetSnapSurveyFile: " & clinicName
Dim SQLString As String
SQLString = "SELECT ExcelFileName " & _
" FROM ExcelLoadConfig " & _
" WHERE ClinicID = " & clinicID & _
" AND ExcelFileType = 'SatSurvey'"
Dim RecSet As ADODB.Recordset
Set RecSet = New ADODB.Recordset
LogManager.Log TraceLevel, SQLString
RecSet.Open Source:=SQLString, ActiveConnection:=CStr(TempVars!constring)
While Not RecSet.EOF And Not RecSet.BOF
Dim clinicLinkText As String
clinicLinkText = LCase(RecSet.Fields(0)) 'note: the links are case sensitive when finding them on the web site
With SSWD
.fileName = clinicLinkText & Tools.GetGeneralConfig("GetSnapSurveyFile", "FileExtension", "SatSurvey")
.SiteValue(CStr(clinicLinkKey)) = clinicLinkText
.DownloadDriver webDLStatus
End With
RecSet.MoveNext
Wend
CleanExit:
If RecSet.State <> adStateClosed Then
RecSet.Close
End If
Exit Function
ErrorHandler:
Resume CleanExit
End Function
Note that OP is aware of SQL injection and the dangers of building the query string this way vs a parameterized query. However the parameter being built into the string comes from the database itself and is passed in with no opportunity for an end user to make a malicious change to it. There are only two of us with access to the database and neither of us wants to put in the effort to clean up after a malicious attack. Should this be changed? Yes. Probably won't happen today.
.DownloadDriver
is implemented here:
Private Sub IWebDownloader_DownloadDriver(ByRef webDLStatus As WebDownloaderStatus)
On Error GoTo ErrorHandler
LogManager.Log TraceLevel, "SnapSurveyWebDownloader.IWebDownloader_DownloadDriver"
If Not this.IsPageLoaded Then
IWebDownloader_LoadWebPage webDLStatus
End If
If this.IsPageLoaded Then
If Not this.IsLoggedIn Then
IWebDownloader_LoginToWebPage webDLStatus
End If
If this.IsLoggedIn Then
If IWebDownloader_NavigateToDownloadLocation(webDLStatus) Then
IWebDownloader_DownloadFile webDLStatus
End If
End If
End If
CleanExit:
Exit Sub
ErrorHandler:
With webDLStatus
Err.Raise .downloadStatus, Err.Source, .statusMessage
End With
Resume CleanExit
End Sub
And the page itself is loaded here:
Private Sub IWebDownloader_LoadWebPage(ByRef webDLStatus As WebDownloaderStatus)
'' NOTE: If downloads fail with err.Number = 13, it's likely that a new ChromeDriver is needed
'' Check here for an updated version:
'' https://sites.google.com/a/chromium.org/chromedriver/downloads
'' Put the chromedriver.exe file here:
'' C:\Users\<user>\AppData\Local\SeleniumBasic
'' note that from <user> down are hidden directories and "Find" won't search them.
LogManager.Log DebugLevel, "SnapSurveyWebDownloader.IWebDownloader_LoadWebPage"
On Error GoTo ErrorHandler
Dim startTime As Single
startTime = Timer
this.IsPageLoaded = this.Driver.Get(this.URL, timeout:=60000) 'give a generous 30 seconds for the page to load
Dim EndTime As Single
EndTime = Timer
this.Driver.Timeouts.ImplicitWait = CLng((EndTime - startTime) * 2000) 'dynamically adjust the timeout to the current page load speed
LogManager.Log InfoLevel, "Driver timeout set to: " & CStr(this.Driver.Timeouts.ImplicitWait)
CleanExit:
Exit Sub
ErrorHandler:
this.IsPageLoaded = False
webDLStatus.downloadStatus = SiteNotLoaded
With Err
LogManager.Log ErrorLevel, "SnapSurvey page failed to load. Number: " & .Number & " Description: " & .Description
If .Number = 13 Then
LogManager.Log ErrorLevel, " >>>> it's likely that there's a new version of ChromeDriver needed"
End If
webDLStatus.statusMessage = "SnapSurvey page failed to load. Number: " & .Number & " Description: " & .Description
.Raise webDLStatus.downloadStatus, "SnapSurveyWebDownloader.IWebDownloader_LoadWebPage", webDLStatus.statusMessage
End With
Resume CleanExit
End Sub
OP notes that this is a good example of why code comments are so dangerous - the code gives a generous 60 seconds before timing out, however the comment says only 30 seconds. I'll just remove that comment and escort the OP to the door...