|
- Option Explicit
- Dim dev:dev = True
- Dim outFile
- Dim WaitTime:WaitTime = 15000
- Dim DataDirectory
- Dim ExportDirectory
- Dim PurpleEnvelopeProofReport
- Dim WshShell:Set WshShell = WScript.CreateObject("Wscript.Shell")
- Dim oConn:Set oConn = WScript.CreateObject("ADODB.Connection")
- Dim ConnectionString
- Dim objFSO:Set objFSO = CreateObject("Scripting.FileSystemObject")
- Dim glob:set glob = CreateObject("Chilkat_9_5_0.Global")
- Dim success:success = glob.UnlockBundle("KENTCM.CB1022025_RGzBPM5J655e")
-
- If (success <> 1) Then
- WriteLine(glob.LastErrorText)
- WScript.Quit
- End If
-
- Dim objCSV:Set objCsv = CreateObject("Chilkat_9_5_0.Csv")
- Dim WorkingDirectory:WorkingDirectory = Replace(WScript.ScriptFullName,WScript.ScriptName,"")
- If dev Then
- DataDirectory = WorkingDirectory & "test"
- ExportDirectory = "\\kci-syn-cl01\PC Transfer\TrackingDataExport\"
- ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Jet OLEDB:Engine Type=5;Data Source=F:\Development\Tracking_Kits\Data\webdata - Copy.mdb;"
- PurpleEnvelopeProofReport = "F:\Development\Tracking_Kits\Data\Proofs.rep"
- set outFile = objFSO.CreateTextFile("\\kci-syn-cl01\PC Transfer\TrackingDataExport\temp.csv",True)
- Else
- DataDirectory = "\\kci-syn-cl01\PC Transfer\TrackingDataImport"
- ExportDirectory = "\\kci-syn-cl01\PC Transfer\TrackingDataExport\"
- ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Jet OLEDB:Engine Type=5;Data Source=C:\inetpub\Data\webdata - Copy.mdb;"
- PurpleEnvelopeProofReport ="C:\inetpub\tracking\Data\Proofs.rep"
- set outFile = objFSO.CreateTextFile("\\kci-syn-cl01\PC Transfer\TrackingDataExport\temp.csv",True)
- End If
-
-
-
- Dim KitID:CheckForFiles:KitID = CheckForJobsToCass()
- If KitID > 0 Then
- ExportMMCsv(KitID)
- RunMailManager
- ImportCass
- End If
- KitID = CheckForReadyToLabel():If KitID > 0 Then:createTrackingInfoForKit(KitID):End If
- KitID = CheckForReadyToExportToSnailWorks():If KitID > 0 Then:CreateExportForSnailWorks(KitID):End If
- KitID = CheckForProofReady(KitID):If KitID > 0 Then:CreateProofForJurisdiction(KitID):End If
-
- WScript.Quit
- Function CreateProofForJurisdiction(KitID)
- Dim Qpdf:Set Qpdf = WScript.CreateObject("DebenuPDFLibraryAX1013.PDFLibrary")
- Dim Result:Result = Qpdf.UnlockKey("j564z3wi9i66k93cp3r798b3y")
- If oConn.State = 0 Then:oConn.Open(ConnectionString):End If
- Dim Rs:set Rs = oConn.Execute("SELECT MIN(ID) as [MIN],MAX(ID) as [MAX] FROM InkjetRecords WHERE KitID = " & KitID &";")
- Dim MIN:MIN = Rs("MIN").Value
- Dim MAX:MAX = Rs("MAX").Value
- Dim RecordCount:RecordCount = (MAX - MIN) + 1
- Rs.Close
- Dim KitRs:set KitRs = oConn.Execute("Select * From [Kit] Where [ID] =" & KitID & ";")
- Dim JurisdictionRs:set JurisdictionRs = oConn.Execute("SELECt * FROM [Jurisdiction] WHERE JCode='" & KitRs("Jcode").Value & "';")
- Dim ProofFileName:ProofFileName = objFSO.GetBaseName(KitRs("Filename")) & "-PROOF.PDF"
- If Not objFSO.FolderExists(ExportDirectory & KitRs("JobNumber").Value & "-" & JurisdictionRs("Name").value) Then:objFSO.CreateFolder(ExportDirectory & KitRs("JobNumber").Value & "-" & JurisdictionRs("Name").value):End If
- Dim reportManager:set reportManager = CreateObject("ReportMan.ReportManX")
- With reportManager
- .Preview = False
- .ShowProgress = False
- .ShowPrintDialog = False
- .filename = PurpleEnvelopeProofReport
- .SetDatabaseConnectionString "WEBDATA",ConnectionString
- .SetParamValue "PBKITID",KitID
- .SetParamValue "PBJCODE",KitRs("Jcode").Value
- Dim MAXRECORDS:MAXRECORDS = 3750
- If RecordCount > MAXRECORDS Then
- Dim i
- For i = 0 To RecordCount / MAXRECORDS
-
-
- Dim newMin:If MIN + (i * MAXRECORDS) > MIN Then:newMin = MIN + (i * MAXRECORDS) + 1:Else newMin = MIN:End If
- Dim newMax:If MIN + (i * MAXRECORDS) + MAXRECORDS > MAX Then:newMax = MAX:Else newMax = MIN + (i * MAXRECORDS) + MAXRECORDS:End If
- .SetParamValue "PBMIN",newMin
- .SetParamValue "PBMAX",newMax
- .SaveToPDF ExportDirectory & KitRs("JobNumber").Value & "-" & JurisdictionRs("Name").value & "\Part_" & i & "_" & ProofFileName,1
- Result = Qpdf.AddToFileList("Proofs",ExportDirectory & KitRs("JobNumber").Value & "-" & JurisdictionRs("Name").value & "\Part_" & i & "_" & ProofFileName)
- Next
- Result = Qpdf.MergeFileListFast("Proofs",ExportDirectory & KitRs("JobNumber").Value & "-" & JurisdictionRs("Name").value & "/" & ProofFileName)
- Dim test
- For test = 1 To Qpdf.FileListCount("Proofs")
-
- WshShell.Run "cmd.exe /c DEL /F /Q """ & Qpdf.FileListItem("Proofs",test) & """" ,0,True
-
- Next
- Else
- .SetParamValue "PBMIN",MIN
- .SetParamValue "PBMAX",MAX
- .SaveToPDF ExportDirectory & KitRs("JobNumber").Value & "-" & JurisdictionRs("Name").value & "/" & ProofFileName,1
- End If
- End With
- oConn.Execute("UPDATE KIT SET [Status] ='Ready For Inkjet Export' WHERE [ID] =" & KitID & ";")
- If KitRs.State = 1 Then:KitRs.Close:End If
- If JurisdictionRs.State = 1 Then:JurisdictionRs.Close:End If
- If oConn.State = 1 Then:oConn.Close:End If
-
- End Function
-
- Function CheckForProofReady(KitID)
- If oConn.State = 0 Then:oConn.Open(ConnectionString):End If
- Dim rs:Set rs = oConn.Execute("Select TOP 1 [ID] FROM [Kit] Where Status ='Ready to Proof' and JobType='Purple Envelopes';")
- If Not rs.EOF Then
- CheckForProofReady = rs("ID").value
- Else
- CheckForProofReady = 0
- End If
- If rs.State = 1 Then:rs.Close:End If
- If oConn.State = 1 Then:oConn.Close:End If
-
- End Function
- Function CheckForReadyToExportToSnailWorks()
- If oConn.State = 0 Then:oConn.Open(ConnectionString):End If
- Dim rs:Set rs = oConn.Execute("Select TOP 1 [ID] FROM [Kit] Where Status ='Ready For Export' and JobType='Purple Envelopes';")
- If Not rs.EOF Then
- CheckForReadyToExportToSnailWorks = rs("ID").value
- Else
- CheckForReadyToExportToSnailWorks = 0
- End If
- If rs.State = 1 Then:rs.Close:End If
- If oConn.State = 1 Then:oConn.Close:End If
- End Function
-
- Function CreateExportForSnailWorks(KitID)
- If oConn.State = 0 Then:oConn.Open(ConnectionString):End If
- Dim KitRs:set KitRs = oConn.Execute("Select * From [Kit] Where [ID] =" & KitID & ";")
- Dim KitLabelsRs: Set KitLabelsRs = oConn.Execute("SELECT InkjetRecords.ID, InkjetRecords.KitID, InkjetRecords.VOTERID, InkjetRecords.LASTNAME," &_
- " InkjetRecords.FIRSTNAME, InkjetRecords.MIDDLENAME, InkjetRecords.SUFFIX, InkjetRecords.PRECINCT," &_
- " InkjetRecords.ADDRESS1, InkjetRecords.ADDRESS2, InkjetRecords.ADDRESS3, InkjetRecords.ADDRESS4," &_
- " InkjetRecords.ADDRESS5, InkjetRecords.APPSENT, InkjetRecords.APPRETURNED, InkjetRecords.BALSENT," &_
- " InkjetRecords.BALRETURNED, InkjetRecords.CountingBoard, InkjetRecords.UOCAVASTATUS, InkjetRecords.EMAILADDRESS," &_
- " InkjetRecords.PHONENUMBER, InkjetRecords.BALLOT_NUMBER, InkjetRecords.CassADDRESS1, InkjetRecords.CassADDRESS2," &_
- " InkjetRecords.CassADDRESS3, InkjetRecords.CassADDRESS4, InkjetRecords.CassADDRESS5, InkjetRecords.KitLabelID," &_
- " KitLabels.ID, KitLabels.KitID, KitLabels.OutboundSerial, KitLabels.InBoundSerial, KitLabels.OutboundIMB," &_
- " KitLabels.InBoundIMB, KitLabels.OutboundIMBDigits, KitLabels.InBoundIMBDigits, KitLabels.OutboundIMBPNG," &_
- " KitLabels.INBOUNDIMBPNG, KitLabels.SetNumber" &_
- " FROM InkjetRecords" &_
- " LEFT JOIN [KitLabels] ON InkjetRecords.KitLabelID = KitLabels.ID" & _
- " WHERE InkjetRecords.KitID =" & KitID & " ;")
- Dim JurisdictionRs:Set JurisdictionRs = oConn.Execute("SELECT * FROM Jurisdiction WHERE JCode ='" & KitRs("Jcode").Value & "';")
- Dim ExportFileName:ExportFileName = objFSO.GetBaseName(KitRs("Filename")) & "_SW_EXPORT"
-
- If Not objFSO.FolderExists(ExportDirectory & KitRs("JobNumber").Value & "-" & JurisdictionRs("Name").value) Then:objFSO.CreateFolder(ExportDirectory & KitRs("JobNumber").Value & "-" & JurisdictionRs("Name").value):End If
-
- If objFSO.FileExists(ExportDirectory & KitRs("JobNumber").Value & "-" & JurisdictionRs("Name").value & "/" & ExportFileName) Then:objFSO.DeleteFile(ExportDirectory & KitRs("JobNumber").Value & "-" & JurisdictionRs("Name").value & "/" & ExportFileName):End If
- Dim objExportFile:set objExportFile = objFSO.CreateTextFile(ExportDirectory & KitRs("JobNumber").Value & "-" & JurisdictionRs("Name").value & "/" & ExportFileName,2)
- With objExportFile
- .Write("H") 'Record Type Required value must be = "H" (Header)
- .Write(PadString("5.1",5)) 'Version Required value must be ="5.1" for current release
- .Write(PadString("KCI",50)) 'UserId Required
- .Write(PadString(JurisdictionRs("Name").Value,50)) 'Client Name Required (will create new subaccount if not already defined)
- .Write(PadString("",50)) 'Parent Client Name Optional (use if 3-tier account structure)
- .Write(PadString("Purple envelope - " & KitRs("JobNumber").Value,50)) 'Job Name Required
- .Write(PadString("",50)) 'Job Description Optional
- .Write(PadString("",50)) 'Split Name Optional – will default to ‘Default’
- .Write(PadString("",80)) 'Split Description Optional
- .Write(PadString("L",1)) 'Piece Type Required L-Letters, C-Cards, F-Flats
- .Write(PadString(Year(Now()) & "/" &_
- Right("0" & Month(Now()), 2) & "/" & Right("0" & Day(Now()), 2),10)) 'MailDate Required (YYYY/MM/DD)
- .Write(PadString("N",1)) 'UploadType Required N = New job, new split A = Append new split to existing job R = Replace existing split
- .Write(PadString("",8)) 'TrackedQuantity Optional
- .Write(PadString("",8)) 'PiecesMailed Optional – shown as Estimated Quantity
- .Write(PadString("",10)) 'Target InHomeDateStart Optional (YYYY/MM/DD)
- .Write(PadString("",10)) 'Target InHomeDateEnd Optional (YYYY/MM/DD)
- .Write(PadString("",100)) 'ConfirmationEmail Optional
- .Write(PadString("",9)) 'JobId (SW) Optional for previously created jobs SWJobId
- .Write(PadString("",4)) 'SplitId (SW) Optional for previously created jobs SWJobId
- .Write(PadString(Choice(IsNull(KitRs("InboundSTID")),"O","R"),1)) 'TypeofTracking Required Values: O- Outbound Only I-Inbound Only R-Round Trip
- .Write(PadString("",11)) 'ReturnedPostalRoutingCode
- .Write(PadString("",2)) 'ReportId1
- .Write(PadString("",255)) 'Report1Email
- .Write(PadString("",2)) 'ReportId2
- .Write(PadString("",255)) 'Report2Email
- .Write(vbCrLf)
- While Not KitLabelsRs.EOF
- .Write("D") 'RecordType Required value must be = “D” (Detail)
- .Write(PadString("",20)) 'CustomerUniqueIdentifier Optional- any identifier you designate
- .Write(PadString(KitLabelsRs("OutboundIMBDigits"),31)) 'IMB Required – Unencoded, numeric IMB
- .Write(PadString("",10)) 'Greeting Optional
- .Write(PadString("",50)) 'First Name Optional
- .Write(PadString("",2)) 'MI Optional
- .Write(PadString("",50)) 'Last Name Optional
- .Write(PadString("",10)) 'Suffix Optional
- .Write(PadString((KitLabelsRs("CassADDRESS1").Value),100)) 'Full Name Optional
- .Write(PadString("",50)) 'Company Optional
- .Write(PadString("",50)) 'Title Optional
- .Write(PadString(KitLabelsRs("CassADDRESS3").Value,128)) 'Address1 Optional
- .Write(PadString(KitLabelsRs("CassADDRESS4").Value,128)) 'Address2 Optional
- .Write(PadString(Left(KitLabelsRs("CassADDRESS5").Value, _
- InStr(KitLabelsRs("CassADDRESS5").Value, ",") - 1),50)) 'City Optional
- .Write(PadString(Mid(KitLabelsRs("CassADDRESS5").Value, _
- InStr(KitLabelsRs("CassADDRESS5").Value, ",") + 2, 2),2)) 'State Optional
- .Write PadString(Right(KitLabelsRs("CassADDRESS5").Value,11),11) 'Zip Optional
- .Write(PadString(KitRs("Jcode"),100)) 'UserDefined1 Optional - Summary fields only
- .Write(PadString("",100)) 'UserDefined2 Optional - Summary fields only
- .Write(PadString("",100)) 'UserDefined3 Optional - Summary fields only
- .Write(PadString(KitLabelsRs("PRECINCT").Value &_
- KitLabelsRs("BALLOT_NUMBER"),80)) 'UserDefinedIdentifier4 Optional – Allows for unique identifiers
- .Write(PadString(KitLabelsRs("VOTERID").Value,80)) 'UserDefinedIdentifier5 Optional – Allows for unique identifiers
- .Write(PadString("",1)) 'SeedIndicator Optional - if true provide ‘Y’
- .Write(PadString("",80)) 'InductionPoint Optional
- .Write(PadString("",10)) 'InductionDate Optional – Valid date format, ex. MM/DD/YYYY
- .Write(PadString(Choice(IsNull(KitRs("InboundSTID")),"", _
- KitLabelsRs("InBoundIMBDigits").Value),31)) 'InboundIMB Optional – numeric IMB for Round trip jobs only
- .Write(PadString("",24)) 'IMCB Optional – Container Barcode
- .Write(PadString("",24)) 'IMTB Optional – Tray Barcode
- .Write(vbCrLf)
- KitLabelsRs.MoveNext
- Wend
-
- .Close
- End With
- oConn.Execute("UPDATE KIT SET [Status] ='Ready to Proof',[ExportedToSnailWorks] =#" & Now() & "# WHERE [ID] =" & KitID & ";")
- If KitRs.State = 1 Then:KitRs.Close:End If
- If KitLabelsRs.State = 1 Then:KitLabelsRs.Close: End If
- If JurisdictionRs.State = 1 Then:JurisdictionRs.Close:End If
- If oConn.State = 1 Then:oConn.Close:End If
- End Function
-
- Function createTrackingInfoForKit(KitID)
- Dim KitRs:set KitRs = oConn.Execute("Select * from Kit Where ID =" & KitID & ";")
- Dim InkjetRs:Set InkjetRs = oConn.Execute("Select * from InkjetRecords Where KitID =" & KitID & ";")
- Dim JurisRs:set JurisRs = oConn.Execute("Select Right(IMB_Digits,9) as IMBZip FROM Jurisdiction Where JCode ='" & KitRs("Jcode") & "';"):Dim Jcode:Jcode = JurisRs("IMBZip"):JurisRs.Close
- Dim SerialNumberStart:SerialNumberStart = GetSetting("SerialNumberStart")
- Dim serialOffset:serialOffset = GetSetting("SerialOffset")
- Dim serialStart:serialStart = CLng(GetSetting("SerialNumberStart")) + CLng(GetSetting("SerialOffset"))
- Dim Counter:Counter=0
- Dim KitLabelID
- Dim KitLabelRs
- Dim Step : If KitRs("InboundSTID") <> "" Then : Step = 2 : Else Step = 1
- serialStart = PadLeft(serialStart + CLng(Counter),9,"0")
- While Not InkjetRs.EOF
-
- If Step = 1 Then
- oConn.Execute("INSERT INTO KitLabels (KitID,OutboundSerial,OutboundIMBDigits) " &_
- "VALUES(" & KitID & ",'" & serialStart & "','" & KitRs("OutBoundSTID").Value & serialStart & "000000000" & "');")
-
- Else
- oConn.Execute "INSERT INTO KitLabels (KitID,OutboundSerial,InBoundSerial,OutboundIMBDigits,InBoundIMBDigits) " &_
- "VALUES(" & KitID & ",'" & serialStart & "','" & serialStart + 1 & "','" & KitRs("OutBoundSTID").Value & serialStart & "000000000" & "','" & KitRs("InboundSTID").Value & serialStart + 1 & Jcode & "');"
- End If
- Set KitLabelRs = oConn.Execute("SELECT TOP 1 [ID] FROM KitLabels ORDER BY ID DESC"):KitLabelID = KitLabelRs("ID").Value
-
- oConn.Execute("UPDATE InkjetRecords Set [KitLabelID]=" & KitLabelID & " WHERE ID=" & InkjetRs("ID") & ";")
- Counter = Counter + Step
- serialStart = serialStart + Step
-
- InkjetRs.MoveNext
- Wend
- oConn.Execute("UPDATE Settings Set [Value]='" & serialOffset + Counter & "' WHERE [Name] = 'SerialOffset';")
- oConn.Execute("UPDATE Kit Set [Status]='Ready For Export', LabelsPrinted=#" & Now() & "# WHERE [ID] =" & KitID &";")
-
- End Function
-
- Function GetSetting(settingName)
-
- Dim rs:Set rs = oConn.Execute("Select Value From [Settings] Where [Name] = '" & settingName & "';")
-
- If Not rs.EOF Then
- GetSetting = rs(0).value
- rs.Close
- Else
- SetSetting = 0
- rs.Close
- End If
-
-
- End Function
-
-
-
- Function CheckForReadyToLabel()
-
- Dim rs : set rs = oConn.Execute("Select TOP 1 ID from Kit Where Status ='Ready to Assign Labels' ORDER BY ID DESC;")
- If Not rs.EOF Then
- Dim kitId : kitId = rs("ID").value
- rs.Close
- CheckForReadyToLabel = KitID
- oConn.Execute("UPDATE Kit SET Status ='Applying Serial Numbers' WHERE ID =" & KitID & ";")
- Else
- CheckForReadyToLabel = 0
- End If
- End Function
-
-
- Function CheckForFiles()
-
-
- If objFSO.FolderExists(DataDirectory) Then
- Dim objFolder:Set objFolder = objFSO.GetFolder(DataDirectory)
-
- If objFolder.Files.Count > 0 Then
- 'WScript.Echo "Files found in directory: " & DataDirectory
- Dim objFile
- For Each objFile In objFolder.Files
- Dim CsvString:CsvString = ConvertCsvToString(objFile.Path)
- If ValidImportCSV(CsvString) Then
- SetupKit CsvString,objFile.Name
- objFSO.MoveFile objFile.Path, DataDirectory & "\import\" & objFile.Name
- End If
- Next
- Else
- 'WScript.Echo "No files found in directory: " & DataDirectory
- End If
-
- End If
- End Function
-
- Function ValidJcode(jcode)
- Dim oConn
- Set oConn = WScript.CreateObject("ADODB.Connection")
- oConn.ConnectionString = ConnectionString
- oConn.Open
- Dim oRs
- set oRs = oConn.Execute("Select * from Jurisdiction Where [JCode] = '" & jcode & "';")
- If oRs.EOF Then
- ValidJcode = 0
- Else
- ValidJcode = 1
- End If
- oRs.Close
- oConn.Close
- End Function
-
-
- Function SetupKit(CsvString,FileName)
- Dim JobNumber:JobNumber = Mid(FileName,9,6)
- Dim JCode:JCode = Left(Filename,5)
- If IsNumeric(JobNumber) Then
- If ValidJcode(JCode) Then
- WScript.Echo FileName & " Is a Valid CSV for Importing"
- Dim oConn:Set oConn = WScript.CreateObject("ADODB.Connection")
- oConn.ConnectionString = ConnectionString
- oConn.Open
- oConn.Execute("Insert Into Kit ([JobNumber], [Jcode], [CreatedOn], [JobType],[Filename],[Status]) VALUES ('" & JobNumber & "','" & JCode & "',#" & Now() & "#,'Purple Envelopes','" & FileName & "','Importing');")
- Dim rs : set rs = oConn.Execute("Select TOP 1 ID from Kit ORDER BY ID DESC")
- Dim kitId : kitId = rs("ID").value
- rs.close
- Dim i
- For i = 1 To objCSV.NumRows -1
- oConn.Execute("Insert Into [InkjetRecords] (KitID,VOTERID,LASTNAME,FIRSTNAME,MIDDLENAME" & _
- ",SUFFIX,PRECINCT,ADDRESS1,ADDRESS2,ADDRESS3,ADDRESS4,ADDRESS5,APPSENT,APPRETURNED,BALSENT,BALRETURNED" & _
- ",CountingBoard,UOCAVASTATUS,EMAILADDRESS,PHONENUMBER,BALLOT_NUMBER) VALUES (" & kitId & _
- ",'" & Replace(objCSV.GetCell(i,0),"'","''") & _
- "','" & objCsv.GetCell(i,1) & _
- "','" & Replace(objCSV.GetCell(i,2),"'","''") & _
- "','" & Replace(objCSV.GetCell(i,3),"'","''") & _
- "','" & Replace(objCSV.GetCell(i,4),"'","''") & _
- "','" & Replace(objCSV.GetCell(i,5),"'","''") & _
- "','" & Replace(objCSV.GetCell(i,6),"'","''") & _
- "','" & Replace(objCSV.GetCell(i,7),"'","''") & _
- "','" & Replace(objCSV.GetCell(i,8),"'","''") & _
- "','" & Replace(objCSV.GetCell(i,9),"'","''") & _
- "','" & Replace(objCSV.GetCell(i,10),"'","''") & _
- "','" & Replace(objCSV.GetCell(i,11),"'","''") & _
- "','" & Replace(objCSV.GetCell(i,12),"'","''") & _
- "','" & Replace(objCsv.GetCell(i,13),"'","''") & _
- "','" & objCsv.GetCell(i,14) & _
- "','" & objCsv.GetCell(i,15) & _
- "','" & objCsv.GetCell(i,16) & _
- "','" & objCsv.GetCell(i,17) & _
- "','" & objCsv.GetCell(i,18) & _
- "','" & objCsv.GetCell(i,19) & _
- "')")
- Next
- oConn.Execute("Update Kit SET [Status] = 'Ready to Cass' Where ID = " & kitId &";")
- 'oConn.Close
- End If
- End If
-
-
-
- End Function
- Function ConvertCsvToString(FilePath)
- Dim objFSO:Set objFSO = CreateObject("Scripting.FileSystemObject")
- Dim objCsvFile:set objCsvFile = objFSO.OpenTextFile(FilePath)
- Dim strContent:strContent = ""
- Dim intLineCount:intLineCount = 0
- Do Until objCsvFile.AtEndOfStream Or intLineCount >= 3
- objCsvFile.SkipLine
- intLineCount = intLineCount + 1
- Loop
- ' Read the remaining content into a string
-
- Do Until objCsvFile.AtEndOfStream
- Dim strLine:strLine = objCsvFile.ReadLine
- strContent = strContent & strLine & vbCrLf
- Loop
-
- ConvertCsvToString = strContent
- End Function
-
- Function ValidImportCSV(CsvFileAsString)
- objCSV.LoadFromString(CsvFileAsString)
- If objCSV.NumColumns = 20 Then
- debug.WriteLine objCsv.GetCell(1,1)
- ValidImportCSV = True
- Else
- ValidImportCSV = False
- End If
- End Function
-
- Sub ImportCass
- Dim currentRow
- objCsv.LoadFile("\\kci-syn-cl01\PC Transfer\TrackingDataExport\FROM_MM.CSV")
-
- For currentRow = 0 To objCsv.NumRows -1
- oConn.Execute("UPDATE InkJetRecords SET CassADDRESS1 = '" & Replace(objCsv.GetCell(currentRow,1),"'","''") & "', " &_
- "CassADDRESS2 = '" & Replace(objCSV.GetCell(currentRow,3),"'","''") & "', " &_
- "CassADDRESS3 = '" & Replace(objCSV.GetCell(currentRow,4),"'","''") & "', " &_
- "CassADDRESS4 = '" & Replace(objCSV.GetCell(currentRow,5),"'","''") & "', " &_
- "CassADDRESS5 = '" & Replace(objCsv.GetCell(currentRow,6) & ", " & objCsv.GetCell(currentRow,7) & " " & objCsv.GetCell(currentRow,8),"'","''") & "'" &_
- " WHERE ID = " & objCSV.GetCell(currentRow,0) & ";")
-
- Next
-
- oConn.Execute("UPDATE Kit SET Status ='Ready To Assign STIDS' WHERE ID =" & KitID & ";")
- oConn.Execute("UPDATE Kit SET [Cass] = 1 WHERE ID =" & KitID & ";")
- End Sub
-
- Sub RunMailManager
- 'WshShell.Run "\\MM2012\APPS\BCC\MM2010\mailman.exe -p -j MMJOB.mjb -u DAN",1,True
- WshShell.Run "PsExec64.exe -i -e -u ntp\danielc -p SunBrightShine! \\MarkH2 ""\\MM2012\APPS\BCC\MM2010\mailman.exe"" -p -j MMJOB.mjb -u DAN",1,True
- End Sub
- Sub ExportMMCsv(KitId)
-
- Dim success
- objCsv.HasColumnNames = 1
- objCSV.EnableQuotes = 1
- success = objCsv.SetColumnName(0,"ID")
- success = objCsv.SetColumnName(1,"NAME")
- success = objCsv.SetColumnName(2,"ADDRESS1")
- success = objCsv.SetColumnName(3,"ADDRESS2")
- success = objCsv.SetColumnName(4,"ADDRESS3")
- success = objCsv.SetColumnName(5,"ADDRESS4")
- success = objCsv.SetColumnName(6,"ADDRESS5")
- Dim rs : Set rs = oConn.Execute("Select ID," & _
- "IIF(FIRSTNAME IS NULL,'',FIRSTNAME & ' ') & " & _
- "IIF(MIDDLENAME IS NULL,'',MIDDLENAME & ' ') & " & _
- "IIF(LASTNAME IS NULL,'',LASTNAME & ' ') & " & _
- "IIF(SUFFIX IS NULL,'',SUFFIX & ' ') " & _
- "AS NAME, ADDRESS1,ADDRESS2,ADDRESS3,ADDRESS4,ADDRESS5 FROM InkjetRecords WHERE KitID =" & KitID & " ORDER By ID;")
- Dim CurrentRow:CurrentRow = 0
- While Not rs.EOF
- objCSV.SetCell CurrentRow,0,rs("ID").value
- objCSV.SetCell CurrentRow,1,rs("NAME").value
- objCSV.SetCell CurrentRow,2,rs("ADDRESS1").value
- objCSV.SetCell CurrentRow,3,rs("ADDRESS2").value
- objCSV.SetCell CurrentRow,4,rs("ADDRESS3").value
- objCSV.SetCell CurrentRow,5,rs("ADDRESS4").value
- objCSV.SetCell CurrentRow,6,rs("ADDRESS5").value
- rs.MoveNext
- CurrentRow = CurrentRow +1
- Wend
- Dim CsvString:CsvString = objCSV.SaveToString()
- outFile.WriteLine CsvString
- outFile.Close
-
- End Sub
- Function CheckForJobsToCass()
- oConn.ConnectionString = ConnectionString
- oConn.Open
-
- 'oConn.Open
- Dim rs : set rs = oConn.Execute("Select TOP 1 ID from Kit Where Status ='Ready to Cass' ORDER BY ID DESC;")
- If Not rs.EOF Then
- Dim kitId : kitId = rs("ID").value
- rs.Close
- CheckForJobsToCass = KitID
- oConn.Execute("UPDATE Kit SET Status ='Cassing' WHERE ID =" & KitID & ";")
- Else
- CheckForJobsToCass = 0
- End If
- 'oConn.Close
- End Function
-
- Public Function PadLeft(originalString,desiredLength,Char)
- Dim padLength
- padLength = desiredLength - Len(originalString)
- If padLength > 0 Then
- ' Left pad the string with zeros
- PadLeft = String(padLength, Char) & originalString
- Else
- ' If the original string is already longer or equal to the desired length, no padding is needed
- PadLeft = originalString
- End If
-
- End Function
-
- Function PadString(inputString, size)
- Dim paddedString
- Dim inputLength
- Dim i
- If IsNull(inputString) Then:inputString = ""
- ' Get the length of the input string
- inputLength = Len(inputString)
-
- ' If the input string is already equal to or longer than the specified size, return it as is
- If inputLength >= size Then
- PadString = inputString
- Exit Function
- End If
-
- ' Initialize the padded string with the input string
- paddedString = inputString
-
- ' Pad spaces to the right of the input string until it reaches the specified size
- For i = 1 To (size - inputLength)
- paddedString = paddedString & " "
- Next
-
- ' Return the padded string
- PadString = paddedString
- End Function
-
- Function CleanNull(StringToClean)
- If IsNull(StringToClean) Then:CleanNull = "":End If
- End Function
-
- Public Sub Assign(ByRef var, ByVal val)
- If IsObject(val) Then
- Set var = val
- Else
- var = val
- End If
- End Sub
-
- Public Function Choice(ByVal cond, ByVal if_true, ByVal if_false)
- If cond Then
- Assign Choice, if_true
- Else
- Assign Choice, if_false
- End If
- End Function
|