EDN Admin
Well-known member
<span style="font-family:Arial; font-size:small Hi all,
<p style="margin:0cm 0cm 0pt <span style="font-family:Arial; font-size:small
<p style="margin:0cm 0cm 0pt <span style="font-family:Arial; font-size:small Partly for an âIâm boredâ project but also for the benefit of my employer, I have been working for what seems like ages on a script which is a lot of simple processes
put together.
<p style="margin:0cm 0cm 0pt <span style="font-family:Arial; font-size:small
<p style="margin:0cm 0cm 0pt <span style="font-family:Arial; font-size:small As I am more familiar with VBA I have gotten by so far by writing this script in Wordâs VB IDE and was successful in getting the script to work, however my efforts to move
it over to VBscript are not going as well.<span> I have created and ran the script as a VBscript, however I do not get any results at all, no error messages, nothing.
<p style="margin:0cm 0cm 0pt <span style="font-family:Arial; font-size:small
<p style="margin:0cm 0cm 0pt <span style="font-family:Arial; font-size:small Therefore I wondered if any bright sparks were willing to take a look for me and point out where the script may be falling down or where I am going wrong.<span>
Also I have read that there is no similar method for VBscript to debug by stepping through etc, is there any advice or tips regarding the best way to debug?
<p style="margin:0cm 0cm 0pt <span style="font-family:Arial; font-size:small
<p style="margin:0cm 0cm 0pt <span style="font-family:Arial; font-size:small The script itself is meant to handle the following process which has to be manually executed at present.
<p style="margin:0cm 0cm 0pt <span style="font-family:Arial; font-size:small
<ol type="1
<li style="margin:0cm 0cm 0pt <span style="font-family:Arial; font-size:small A random number of PDF files are received with accompanying âExtractâ CSV file which contains data relating to the PDF files.
<li style="margin:0cm 0cm 0pt <span style="font-family:Arial; font-size:small Check to see if PDF Files exist, count them and parses filenames
<li style="margin:0cm 0cm 0pt <span style="font-family:Arial; font-size:small Check to see if Extract CSV exists, opens and parses data (Filename, Supplier Name, Date)
<li style="margin:0cm 0cm 0pt <span style="font-family:Arial; font-size:small Compares Extract Filenames against PDF Filenames.
<li style="margin:0cm 0cm 0pt <span style="font-family:Arial; font-size:small Compares PDF Filenames against Extract Filenames
<li style="margin:0cm 0cm 0pt <span style="font-family:Arial; font-size:small Validates Supplier Name (Checks for Ampersands and Capitalisation of Supplier Name)
<li style="margin:0cm 0cm 0pt <span style="font-family:Arial; font-size:small Rewrites CSV if invalid data detected in stage 6.
<li style="margin:0cm 0cm 0pt <span style="font-family:Arial; font-size:small Copies Extract File to âDataloaderâ folder
<li style="margin:0cm 0cm 0pt <span style="font-family:Arial; font-size:small Rewrites an XML document (this is to start a process in another application).
</ol>
<p style="margin:0cm 0cm 0pt <span style="font-family:Arial; font-size:small
<p style="margin:0cm 0cm 0pt <span style="font-family:Arial; font-size:small I have programmed the script to stop and email various parties if it detects an error at stage 2, 3, 4 or 5, which are the critical bits.
<span style="font-family:Arial; font-size:small I would also be really grateful if anybody could suggest where the code could be refined or made more elegant then this would be ace.
<p style="margin:0cm 0cm 0pt <span style="font-family:Arial; font-size:small
<p style="margin:0cm 0cm 0pt <span style="font-family:Arial; font-size:small Thanking you in anticipation, here is the script:
<p style="margin:0cm 0cm 0pt <span style="font-family:Arial; font-size:small
<pre>
Castle Accounts Payable DataLoad Automation Script 1
Author:
Date: 08/08/2011
Contact: [/code]
<pre> Location: [/code]
<pre>
Option Explicit
Global Declare required counters and error reporting strings
Dim intErrMissingFromExtract, strErrMissingFromExtract
Dim intErrMissingFromFolder, strErrMissingFromFolder
Dim intErrSupplierCaps, strErrSupplierCaps
Dim intErrAmpersands, strErrAmpersands
Dim intInvalidDates, strInvalidDates
Dim intInvoiceCount
Dim strFolderFileName()
Dim oFSO
Dim objExtractCSVFile, objErrorLog
Dim blnError, strError
Dim dtmTodayFull, dtmTodayStamp, dtmExtractFileDate
Dim oEmail
Dim strCastleMsg, strAPMsg, strNorthgateMsg, strSubject, strMessage
Dim strCastleTeamEmail, strAPGroupEmail, strNorthgateViv
Sub APAutomationScriptStage1()
On Error Resume Next
Declare & set Execute time for use in XML Update
Dim strExecutionTime
strExecutionTime = "18:00"
GetDate
dtmTodayFull = Date
dtmTodayStamp = Right(Date, 4) & Mid(Date, 4, 2) & Left(Date, 2)
dtmExtractFileDate = Left(Date, 2) & Mid(Date, 4, 2) & Right(Date, 4)
EMAIL Requirements and Settings
strCastleTeamEmail = "someaccount"
strAPGroupEmail = "someaccount"
strNorthgateViv = "viv.england@example.com"
Set Folder Paths
Dim DataLoadFolder, ArchiveFolder
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set DataLoadFolder = oFSO.GetFolder("C:APAutomationScriptDataload")
Set ArchiveFolder = oFSO.GetFolder("C:APAutomationScriptInvoicesArchive")
Set Error Flag and Create Error Log
blnError = False
If oFSO.FileExists("C:APAutomationScriptAPScriptError.log") Then
Set objErrorLog = oFSO.OpenTextFile("C:APAutomationScriptAPScriptError.log", 8)
Else
Set objErrorLog = oFSO.CreateTextFile("C:APAutomationScriptAPScriptError.log", True)
End If
Stage 1 - Check for PDF Invoices, count them and parse filenames
ReDim strFolderFileName(5000)
Dim InvoiceFolder
Dim FileItem
Dim File
Set InvoiceFolder = oFSO.GetFolder("C:APAutomationScriptInvoices")
Set FileItem = InvoiceFolder.Files
intInvoiceCount = 0
For Each File In FileItem
If LCase(File.Name) Like "*.pdf" Then
strFolderFileName(intInvoiceCount) = Mid(File.Name, 1, Len(File.Name) - 4)
intInvoiceCount = intInvoiceCount + 1
End If
Next
Clean Up Array
ReDim Preserve strFolderFileName(intInvoiceCount - 1)
Respond Accordingly
If intInvoiceCount = 0 Then
blnError = True
strCastleMsg = "No PDF Invoice Images were detected in " & InvoiceFolder
strNorthgateMsg = "Nottingham City Councils Upload of Invoices did not happen!"
strError = Date & " " & Time & " " & "Stage 1 Error - " & strCastleMsg
objErrorLog.WriteLine strError
Set objErrorLog = Nothing
SendMail strCastleTeamEmail, strSubject, strCastleMsg
SendMail strNorthgateViv, strSubject, strNorthgateMsg
End If
Carry on if no error
If blnError = False Then
Stage 2 - Check if csv file exists for todays date, if not email.
If Not oFSO.FileExists(InvoiceFolder & "Extract" & dtmExtractFileDate & ".csv") Then
blnError = True
strCastleMsg = "No Extract.csv file was found for " & dtmExtractFileDate
strNorthgateMsg = "Nottingham City Councils Upload of Invoices did not happen!"
strError = Date & " " & Time & " " & "Stage 2 Error - " & strCastleMsg
objErrorLog.WriteLine strError
Set objErrorLog = Nothing
SendMail strCastleTeamEmail, strSubject, strCastleMsg
SendMail strNorthgateViv, strSubject, strNorthgateMsg
Else
Set objExtractCSVFile = oFSO.OpenTextFile(InvoiceFolder & "Extract" & dtmExtractFileDate & ".csv", ForReading)
End If
End If
If blnError = False Then
Parse CSV File for reading
Dim strExtractSupplier(), dtmExtractDate(), strExtractLine(), strExtractFileName()
Dim intSupplierCount, intTest, intEnd, intCount, strTest
ReDim strExtractSupplier(5000)
ReDim strExtractFileName(5000)
ReDim dtmExtractDate(5000)
ReDim strExtractLine(5000)
intCount = 0
Do While Not objExtractCSVFile.AtEndOfStream
Parse whole line into String Array, then ExtractFileName, SupplierName and Date
strTest = objExtractCSVFile.ReadLine
Test for empty line
If strTest = "" Then
Exit Do
End If
strExtractLine(intCount) = strTest
Get FileName - 26 is position of the end of invoice folder
intTest = InStr(1, strTest, ",", 3)
strExtractFileName(intCount) = Mid(strTest, 27, intTest - 31)
SupplierName
intTest = InStr(intTest + 1, strTest, ",", 3)
intEnd = InStr(intTest + 1, strTest, ",", 3)
strExtractSupplier(intCount) = Mid(strTest, intTest + 1, intEnd - intTest - 1)
Date
intTest = InStr(intTest + 1, strTest, ",", 3)
intTest = InStr(intTest + 1, strTest, ",", 3)
intEnd = InStr(intTest + 1, strTest, ",", 3)
dtmExtractDate(intCount) = Mid(strTest, intTest + 1, intEnd - intTest - 1)
intCount = intCount + 1
Loop
Tidy up arrays & close extract
ReDim Preserve strExtractSupplier(intCount - 1)
ReDim Preserve dtmExtractDate(intCount - 1)
ReDim Preserve strExtractFileName(intCount - 1)
objExtractCSVFile.Close
intErrMissingFromExtract = 0
intErrMissingFromFolder = 0
Stage 3 - Compare Extract to Folder File Names
Dim blnMatch
blnMatch = False
For intCount = 0 To UBound(strExtractFileName)
For intTest = 0 To UBound(strFolderFileName)
If strExtractFileName(intCount) = strFolderFileName(intTest) Then
blnMatch = True
Exit For
End If
Next
If blnMatch = False Then Filename is missing
intErrMissingFromFolder = intErrMissingFromFolder + 1
strErrMissingFromFolder = strErrMissingFromFolder & strExtractFileName(intCount) & _
" is contained in the Extract.csv but is missing from the Invoice Folder." & vbCr
End If
blnMatch = False Reset test
Next
End If
If any missing images are found then set flag and email
If intErrMissingFromFolder > 0 Then
blnError = True
strCastleMsg = "An error was detected by the autoscript!" & vbCr & vbCr & _
intErrMissingFromFolder & " image(s) are listed in the extract " & _
"but the image is not found in the Folder. The name of the image is " & _
strErrMissingFromFolder
strNorthgateMsg = "An error was detected by the autoscript!" & vbCr & vbCr & _
intErrMissingFromFolder & " image(s) are listed in the extract " & _
"but the image is not found in the Folder. The name of the image is " & _
strErrMissingFromFolder
SendMail strCastleTeamEmail, strSubject, strCastleMsg
SendMail strNorthgateViv, strSubject, strNorthgateMsg
End If
If blnError = False Then
If any missing extract entries are found then set flag and email
blnMatch = False
For intCount = 0 To UBound(strFolderFileName)
For intTest = 0 To UBound(strExtractFileName)
If strFolderFileName(intCount) = strExtractFileName(intTest) Then
blnMatch = True
Exit For
End If
Next
If blnMatch = False Then Filename is missing
intErrMissingFromExtract = intErrMissingFromExtract + 1
strErrMissingFromExtract = strErrMissingFromExtract & strFolderFileName(intCount) & _
" is contained in the Invoice Folder but is missing from the Extract.csv." & vbCr
End If
blnMatch = False Reset test
Next
End If
If intErrMissingFromExtract > 0 Then
blnError = True
strCastleMsg = "An error was detected by the autoscript!" & vbCr & vbCr & _
intErrMissingFromExtract & " image(s) are listed in the extract " & _
"but the image is not found in the Folder. The name of the image is " & _
strErrMissingFromExtract
strNorthgateMsg = "An error was detected by the autoscript!" & vbCr & vbCr & _
intErrMissingFromExtract & " image(s) are listed in the extract " & _
"but the image is not found in the Folder. The name of the image is " & _
strErrMissingFromExtract
SendMail strCastleTeamEmail, strSubject, strCastleMsg
SendMail strNorthgateViv, strSubject, strNorthgateMsg
End If
Validate CSV Metadata and rewrite CSV if required
If blnError = False Then
Dim blnReWriteCSV
blnReWriteCSV = False
intCount = 0
intErrSupplierCaps = 0
intErrAmpersands = 0
intInvalidDates = 0
For intCount = 0 To UBound(strExtractSupplier)
Check if Initial Letter is Capital
If Mid(strExtractSupplier(intCount), 1, 1) <> UCase(Mid(strExtractSupplier(intCount), 1, 1)) Then
intErrSupplierCaps = intErrSupplierCaps + 1
strErrSupplierCaps = strErrSupplierCaps & """" & strExtractSupplier(intCount) & """" & " was detected in image reference " & strFolderFileName(intCount) & "." & vbCr
blnReWriteCSV = True
strExtractLine(intCount) = Replace(strExtractLine(intCount), Mid(strExtractSupplier(intCount), 1, 1), UCase(Mid(strExtractSupplier(intCount), 1, 1)), , 1)
End If
No ampersand(&)
strTest = strExtractSupplier(intCount)
For intTest = 1 To Len(strTest)
If Mid(strTest, intTest, 1) = "&" Then
intErrAmpersands = intErrAmpersands + 1
strErrAmpersands = strErrAmpersands & """" & strExtractSupplier(intCount) & """" & " was detected in image reference " & strFolderFileName(intCount) & "." & vbCr
blnReWriteCSV = True
strExtractLine(intCount) = Replace(strExtractLine(intCount), "&", "and", 1)
End If
Next
Check for valid Date
strTest = dtmExtractDate(intCount)
If Mid(strTest, 7, 2) = "00" Then
intInvalidDates = intInvalidDates + 1
strInvalidDates = strInvalidDates & dtmExtractDate(intCount)
blnReWriteCSV = True
strExtractLine(intCount) = Replace(strExtractLine(intCount), "&", "and", 1)
End If
If Mid(strTest, 5, 2) = "00" Then
intInvalidDates = intInvalidDates + 1
strInvalidDates = strInvalidDates & dtmExtractDate(intCount)
blnReWriteCSV = True
Do something???
End If
If Mid(strTest, 1, 4) = "0000" Then
intInvalidDates = intInvalidDates + 1
strInvalidDates = strInvalidDates & dtmExtractDate(intCount)
blnReWriteCSV = True
Do something???
End If
Next
End If
Rewrite CSV file if neccessary
If blnError = False Then
If blnReWriteCSV = True Then
Set objExtractCSVFile = oFSO.OpenTextFile(InvoiceFolder & "Extract" & dtmExtractFileDate & ".csv", 2)
For intCount = 0 To UBound(strExtractSupplier)
objExtractCSVFile.WriteLine (strExtractLine(intCount))
Next
End If
objExtractCSVFile.Close
End If
Copy Extract to Data Loader folder (overwrite existing dump.csv) & rename to "dump.csv"
If blnError = False Then
If oFSO.FileExists(InvoiceFolder & "Extract" & dtmExtractFileDate & ".csv") Then
oFSO.GetFile(InvoiceFolder & "Extract" & dtmExtractFileDate & ".csv").Copy DataLoadFolder & "dump.csv", True
End If
End If
Declare XML Requirements, set start document to 1 and date/time to current day and ExecutionTime
Dim XML, Nodes, Node, i
Set XML = CreateObject("MSXML2.DOMDocument")
XML.async = False
XML.Load "C:APAutomationScriptDataloadmap.xml"
Set Nodes = XML.SelectNodes("//Map/Schedule/")
For Each Node In Nodes
Select Case Node.nodeName
Case "StartDocument"
Node.Text = "1"
Case "Time"
Node.Text = strExecutionTime
Case "Date"
Node.Text = Day(Date)
Case "Month"
Node.Text = Month(Date)
Case "Year"
Node.Text = Year(Date)
End Select
Next
XML.Save "C:APAutomationScriptDataloadmap.xml"
Clean Up
Set oFSO = Nothing
Set objExtractCSVFile = Nothing
Set DataLoadFolder = Nothing
Set ArchiveFolder = Nothing
Set InvoiceFolder = Nothing
Set objExtractCSVFile = Nothing
Set XML = Nothing
Set Nodes = Nothing
End Sub
Function SendMail(strSendTo, strSubject, strMessage)
Set oEmail = CreateObject("CDO.Message")
Configure message
With oEmail.Configuration.Fields
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "mailrelay.nottinghamcity.gov.uk"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1 basic
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") =
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") =
.Update
End With
build message
With oEmail
.From = "Castle AP Automated Data Load Report"
.To = strSendTo
.Subject = strSubject
.TextBody = strMessage
End With
Send message
On Error Resume Next
oEmail.Send
If Err Then
WScript.Echo "SendMail Failed:" & Err.Description
End If
Clean Up
Set oEmail = Nothing
Err.Clear
On Error GoTo 0
End Function
[/code]
<br/>
View the full article
<p style="margin:0cm 0cm 0pt <span style="font-family:Arial; font-size:small
<p style="margin:0cm 0cm 0pt <span style="font-family:Arial; font-size:small Partly for an âIâm boredâ project but also for the benefit of my employer, I have been working for what seems like ages on a script which is a lot of simple processes
put together.
<p style="margin:0cm 0cm 0pt <span style="font-family:Arial; font-size:small
<p style="margin:0cm 0cm 0pt <span style="font-family:Arial; font-size:small As I am more familiar with VBA I have gotten by so far by writing this script in Wordâs VB IDE and was successful in getting the script to work, however my efforts to move
it over to VBscript are not going as well.<span> I have created and ran the script as a VBscript, however I do not get any results at all, no error messages, nothing.
<p style="margin:0cm 0cm 0pt <span style="font-family:Arial; font-size:small
<p style="margin:0cm 0cm 0pt <span style="font-family:Arial; font-size:small Therefore I wondered if any bright sparks were willing to take a look for me and point out where the script may be falling down or where I am going wrong.<span>
Also I have read that there is no similar method for VBscript to debug by stepping through etc, is there any advice or tips regarding the best way to debug?
<p style="margin:0cm 0cm 0pt <span style="font-family:Arial; font-size:small
<p style="margin:0cm 0cm 0pt <span style="font-family:Arial; font-size:small The script itself is meant to handle the following process which has to be manually executed at present.
<p style="margin:0cm 0cm 0pt <span style="font-family:Arial; font-size:small
<ol type="1
<li style="margin:0cm 0cm 0pt <span style="font-family:Arial; font-size:small A random number of PDF files are received with accompanying âExtractâ CSV file which contains data relating to the PDF files.
<li style="margin:0cm 0cm 0pt <span style="font-family:Arial; font-size:small Check to see if PDF Files exist, count them and parses filenames
<li style="margin:0cm 0cm 0pt <span style="font-family:Arial; font-size:small Check to see if Extract CSV exists, opens and parses data (Filename, Supplier Name, Date)
<li style="margin:0cm 0cm 0pt <span style="font-family:Arial; font-size:small Compares Extract Filenames against PDF Filenames.
<li style="margin:0cm 0cm 0pt <span style="font-family:Arial; font-size:small Compares PDF Filenames against Extract Filenames
<li style="margin:0cm 0cm 0pt <span style="font-family:Arial; font-size:small Validates Supplier Name (Checks for Ampersands and Capitalisation of Supplier Name)
<li style="margin:0cm 0cm 0pt <span style="font-family:Arial; font-size:small Rewrites CSV if invalid data detected in stage 6.
<li style="margin:0cm 0cm 0pt <span style="font-family:Arial; font-size:small Copies Extract File to âDataloaderâ folder
<li style="margin:0cm 0cm 0pt <span style="font-family:Arial; font-size:small Rewrites an XML document (this is to start a process in another application).
</ol>
<p style="margin:0cm 0cm 0pt <span style="font-family:Arial; font-size:small
<p style="margin:0cm 0cm 0pt <span style="font-family:Arial; font-size:small I have programmed the script to stop and email various parties if it detects an error at stage 2, 3, 4 or 5, which are the critical bits.
<span style="font-family:Arial; font-size:small I would also be really grateful if anybody could suggest where the code could be refined or made more elegant then this would be ace.
<p style="margin:0cm 0cm 0pt <span style="font-family:Arial; font-size:small
<p style="margin:0cm 0cm 0pt <span style="font-family:Arial; font-size:small Thanking you in anticipation, here is the script:
<p style="margin:0cm 0cm 0pt <span style="font-family:Arial; font-size:small
<pre>
Castle Accounts Payable DataLoad Automation Script 1
Author:
Date: 08/08/2011
Contact: [/code]
<pre> Location: [/code]
<pre>
Option Explicit
Global Declare required counters and error reporting strings
Dim intErrMissingFromExtract, strErrMissingFromExtract
Dim intErrMissingFromFolder, strErrMissingFromFolder
Dim intErrSupplierCaps, strErrSupplierCaps
Dim intErrAmpersands, strErrAmpersands
Dim intInvalidDates, strInvalidDates
Dim intInvoiceCount
Dim strFolderFileName()
Dim oFSO
Dim objExtractCSVFile, objErrorLog
Dim blnError, strError
Dim dtmTodayFull, dtmTodayStamp, dtmExtractFileDate
Dim oEmail
Dim strCastleMsg, strAPMsg, strNorthgateMsg, strSubject, strMessage
Dim strCastleTeamEmail, strAPGroupEmail, strNorthgateViv
Sub APAutomationScriptStage1()
On Error Resume Next
Declare & set Execute time for use in XML Update
Dim strExecutionTime
strExecutionTime = "18:00"
GetDate
dtmTodayFull = Date
dtmTodayStamp = Right(Date, 4) & Mid(Date, 4, 2) & Left(Date, 2)
dtmExtractFileDate = Left(Date, 2) & Mid(Date, 4, 2) & Right(Date, 4)
EMAIL Requirements and Settings
strCastleTeamEmail = "someaccount"
strAPGroupEmail = "someaccount"
strNorthgateViv = "viv.england@example.com"
Set Folder Paths
Dim DataLoadFolder, ArchiveFolder
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set DataLoadFolder = oFSO.GetFolder("C:APAutomationScriptDataload")
Set ArchiveFolder = oFSO.GetFolder("C:APAutomationScriptInvoicesArchive")
Set Error Flag and Create Error Log
blnError = False
If oFSO.FileExists("C:APAutomationScriptAPScriptError.log") Then
Set objErrorLog = oFSO.OpenTextFile("C:APAutomationScriptAPScriptError.log", 8)
Else
Set objErrorLog = oFSO.CreateTextFile("C:APAutomationScriptAPScriptError.log", True)
End If
Stage 1 - Check for PDF Invoices, count them and parse filenames
ReDim strFolderFileName(5000)
Dim InvoiceFolder
Dim FileItem
Dim File
Set InvoiceFolder = oFSO.GetFolder("C:APAutomationScriptInvoices")
Set FileItem = InvoiceFolder.Files
intInvoiceCount = 0
For Each File In FileItem
If LCase(File.Name) Like "*.pdf" Then
strFolderFileName(intInvoiceCount) = Mid(File.Name, 1, Len(File.Name) - 4)
intInvoiceCount = intInvoiceCount + 1
End If
Next
Clean Up Array
ReDim Preserve strFolderFileName(intInvoiceCount - 1)
Respond Accordingly
If intInvoiceCount = 0 Then
blnError = True
strCastleMsg = "No PDF Invoice Images were detected in " & InvoiceFolder
strNorthgateMsg = "Nottingham City Councils Upload of Invoices did not happen!"
strError = Date & " " & Time & " " & "Stage 1 Error - " & strCastleMsg
objErrorLog.WriteLine strError
Set objErrorLog = Nothing
SendMail strCastleTeamEmail, strSubject, strCastleMsg
SendMail strNorthgateViv, strSubject, strNorthgateMsg
End If
Carry on if no error
If blnError = False Then
Stage 2 - Check if csv file exists for todays date, if not email.
If Not oFSO.FileExists(InvoiceFolder & "Extract" & dtmExtractFileDate & ".csv") Then
blnError = True
strCastleMsg = "No Extract.csv file was found for " & dtmExtractFileDate
strNorthgateMsg = "Nottingham City Councils Upload of Invoices did not happen!"
strError = Date & " " & Time & " " & "Stage 2 Error - " & strCastleMsg
objErrorLog.WriteLine strError
Set objErrorLog = Nothing
SendMail strCastleTeamEmail, strSubject, strCastleMsg
SendMail strNorthgateViv, strSubject, strNorthgateMsg
Else
Set objExtractCSVFile = oFSO.OpenTextFile(InvoiceFolder & "Extract" & dtmExtractFileDate & ".csv", ForReading)
End If
End If
If blnError = False Then
Parse CSV File for reading
Dim strExtractSupplier(), dtmExtractDate(), strExtractLine(), strExtractFileName()
Dim intSupplierCount, intTest, intEnd, intCount, strTest
ReDim strExtractSupplier(5000)
ReDim strExtractFileName(5000)
ReDim dtmExtractDate(5000)
ReDim strExtractLine(5000)
intCount = 0
Do While Not objExtractCSVFile.AtEndOfStream
Parse whole line into String Array, then ExtractFileName, SupplierName and Date
strTest = objExtractCSVFile.ReadLine
Test for empty line
If strTest = "" Then
Exit Do
End If
strExtractLine(intCount) = strTest
Get FileName - 26 is position of the end of invoice folder
intTest = InStr(1, strTest, ",", 3)
strExtractFileName(intCount) = Mid(strTest, 27, intTest - 31)
SupplierName
intTest = InStr(intTest + 1, strTest, ",", 3)
intEnd = InStr(intTest + 1, strTest, ",", 3)
strExtractSupplier(intCount) = Mid(strTest, intTest + 1, intEnd - intTest - 1)
Date
intTest = InStr(intTest + 1, strTest, ",", 3)
intTest = InStr(intTest + 1, strTest, ",", 3)
intEnd = InStr(intTest + 1, strTest, ",", 3)
dtmExtractDate(intCount) = Mid(strTest, intTest + 1, intEnd - intTest - 1)
intCount = intCount + 1
Loop
Tidy up arrays & close extract
ReDim Preserve strExtractSupplier(intCount - 1)
ReDim Preserve dtmExtractDate(intCount - 1)
ReDim Preserve strExtractFileName(intCount - 1)
objExtractCSVFile.Close
intErrMissingFromExtract = 0
intErrMissingFromFolder = 0
Stage 3 - Compare Extract to Folder File Names
Dim blnMatch
blnMatch = False
For intCount = 0 To UBound(strExtractFileName)
For intTest = 0 To UBound(strFolderFileName)
If strExtractFileName(intCount) = strFolderFileName(intTest) Then
blnMatch = True
Exit For
End If
Next
If blnMatch = False Then Filename is missing
intErrMissingFromFolder = intErrMissingFromFolder + 1
strErrMissingFromFolder = strErrMissingFromFolder & strExtractFileName(intCount) & _
" is contained in the Extract.csv but is missing from the Invoice Folder." & vbCr
End If
blnMatch = False Reset test
Next
End If
If any missing images are found then set flag and email
If intErrMissingFromFolder > 0 Then
blnError = True
strCastleMsg = "An error was detected by the autoscript!" & vbCr & vbCr & _
intErrMissingFromFolder & " image(s) are listed in the extract " & _
"but the image is not found in the Folder. The name of the image is " & _
strErrMissingFromFolder
strNorthgateMsg = "An error was detected by the autoscript!" & vbCr & vbCr & _
intErrMissingFromFolder & " image(s) are listed in the extract " & _
"but the image is not found in the Folder. The name of the image is " & _
strErrMissingFromFolder
SendMail strCastleTeamEmail, strSubject, strCastleMsg
SendMail strNorthgateViv, strSubject, strNorthgateMsg
End If
If blnError = False Then
If any missing extract entries are found then set flag and email
blnMatch = False
For intCount = 0 To UBound(strFolderFileName)
For intTest = 0 To UBound(strExtractFileName)
If strFolderFileName(intCount) = strExtractFileName(intTest) Then
blnMatch = True
Exit For
End If
Next
If blnMatch = False Then Filename is missing
intErrMissingFromExtract = intErrMissingFromExtract + 1
strErrMissingFromExtract = strErrMissingFromExtract & strFolderFileName(intCount) & _
" is contained in the Invoice Folder but is missing from the Extract.csv." & vbCr
End If
blnMatch = False Reset test
Next
End If
If intErrMissingFromExtract > 0 Then
blnError = True
strCastleMsg = "An error was detected by the autoscript!" & vbCr & vbCr & _
intErrMissingFromExtract & " image(s) are listed in the extract " & _
"but the image is not found in the Folder. The name of the image is " & _
strErrMissingFromExtract
strNorthgateMsg = "An error was detected by the autoscript!" & vbCr & vbCr & _
intErrMissingFromExtract & " image(s) are listed in the extract " & _
"but the image is not found in the Folder. The name of the image is " & _
strErrMissingFromExtract
SendMail strCastleTeamEmail, strSubject, strCastleMsg
SendMail strNorthgateViv, strSubject, strNorthgateMsg
End If
Validate CSV Metadata and rewrite CSV if required
If blnError = False Then
Dim blnReWriteCSV
blnReWriteCSV = False
intCount = 0
intErrSupplierCaps = 0
intErrAmpersands = 0
intInvalidDates = 0
For intCount = 0 To UBound(strExtractSupplier)
Check if Initial Letter is Capital
If Mid(strExtractSupplier(intCount), 1, 1) <> UCase(Mid(strExtractSupplier(intCount), 1, 1)) Then
intErrSupplierCaps = intErrSupplierCaps + 1
strErrSupplierCaps = strErrSupplierCaps & """" & strExtractSupplier(intCount) & """" & " was detected in image reference " & strFolderFileName(intCount) & "." & vbCr
blnReWriteCSV = True
strExtractLine(intCount) = Replace(strExtractLine(intCount), Mid(strExtractSupplier(intCount), 1, 1), UCase(Mid(strExtractSupplier(intCount), 1, 1)), , 1)
End If
No ampersand(&)
strTest = strExtractSupplier(intCount)
For intTest = 1 To Len(strTest)
If Mid(strTest, intTest, 1) = "&" Then
intErrAmpersands = intErrAmpersands + 1
strErrAmpersands = strErrAmpersands & """" & strExtractSupplier(intCount) & """" & " was detected in image reference " & strFolderFileName(intCount) & "." & vbCr
blnReWriteCSV = True
strExtractLine(intCount) = Replace(strExtractLine(intCount), "&", "and", 1)
End If
Next
Check for valid Date
strTest = dtmExtractDate(intCount)
If Mid(strTest, 7, 2) = "00" Then
intInvalidDates = intInvalidDates + 1
strInvalidDates = strInvalidDates & dtmExtractDate(intCount)
blnReWriteCSV = True
strExtractLine(intCount) = Replace(strExtractLine(intCount), "&", "and", 1)
End If
If Mid(strTest, 5, 2) = "00" Then
intInvalidDates = intInvalidDates + 1
strInvalidDates = strInvalidDates & dtmExtractDate(intCount)
blnReWriteCSV = True
Do something???
End If
If Mid(strTest, 1, 4) = "0000" Then
intInvalidDates = intInvalidDates + 1
strInvalidDates = strInvalidDates & dtmExtractDate(intCount)
blnReWriteCSV = True
Do something???
End If
Next
End If
Rewrite CSV file if neccessary
If blnError = False Then
If blnReWriteCSV = True Then
Set objExtractCSVFile = oFSO.OpenTextFile(InvoiceFolder & "Extract" & dtmExtractFileDate & ".csv", 2)
For intCount = 0 To UBound(strExtractSupplier)
objExtractCSVFile.WriteLine (strExtractLine(intCount))
Next
End If
objExtractCSVFile.Close
End If
Copy Extract to Data Loader folder (overwrite existing dump.csv) & rename to "dump.csv"
If blnError = False Then
If oFSO.FileExists(InvoiceFolder & "Extract" & dtmExtractFileDate & ".csv") Then
oFSO.GetFile(InvoiceFolder & "Extract" & dtmExtractFileDate & ".csv").Copy DataLoadFolder & "dump.csv", True
End If
End If
Declare XML Requirements, set start document to 1 and date/time to current day and ExecutionTime
Dim XML, Nodes, Node, i
Set XML = CreateObject("MSXML2.DOMDocument")
XML.async = False
XML.Load "C:APAutomationScriptDataloadmap.xml"
Set Nodes = XML.SelectNodes("//Map/Schedule/")
For Each Node In Nodes
Select Case Node.nodeName
Case "StartDocument"
Node.Text = "1"
Case "Time"
Node.Text = strExecutionTime
Case "Date"
Node.Text = Day(Date)
Case "Month"
Node.Text = Month(Date)
Case "Year"
Node.Text = Year(Date)
End Select
Next
XML.Save "C:APAutomationScriptDataloadmap.xml"
Clean Up
Set oFSO = Nothing
Set objExtractCSVFile = Nothing
Set DataLoadFolder = Nothing
Set ArchiveFolder = Nothing
Set InvoiceFolder = Nothing
Set objExtractCSVFile = Nothing
Set XML = Nothing
Set Nodes = Nothing
End Sub
Function SendMail(strSendTo, strSubject, strMessage)
Set oEmail = CreateObject("CDO.Message")
Configure message
With oEmail.Configuration.Fields
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "mailrelay.nottinghamcity.gov.uk"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1 basic
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") =
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") =
.Update
End With
build message
With oEmail
.From = "Castle AP Automated Data Load Report"
.To = strSendTo
.Subject = strSubject
.TextBody = strMessage
End With
Send message
On Error Resume Next
oEmail.Send
If Err Then
WScript.Echo "SendMail Failed:" & Err.Description
End If
Clean Up
Set oEmail = Nothing
Err.Clear
On Error GoTo 0
End Function
[/code]
<br/>
View the full article