您最多选择25个主题 主题必须以字母或数字开头,可以包含连字符 (-),并且长度不得超过35个字符

TrackingDataImport.vbs 22KB

7 个月前
7 个月前
7 个月前
6 个月前
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501
  1. Option Explicit
  2. Dim dev:dev = True
  3. Dim outFile
  4. Dim WaitTime:WaitTime = 15000
  5. Dim DataDirectory
  6. Dim ExportDirectory
  7. Dim PurpleEnvelopeProofReport
  8. Dim WshShell:Set WshShell = WScript.CreateObject("Wscript.Shell")
  9. Dim oConn:Set oConn = WScript.CreateObject("ADODB.Connection")
  10. Dim ConnectionString
  11. Dim objFSO:Set objFSO = CreateObject("Scripting.FileSystemObject")
  12. Dim glob:set glob = CreateObject("Chilkat_9_5_0.Global")
  13. Dim success:success = glob.UnlockBundle("KENTCM.CB1022025_RGzBPM5J655e")
  14. If (success <> 1) Then
  15. WriteLine(glob.LastErrorText)
  16. WScript.Quit
  17. End If
  18. Dim objCSV:Set objCsv = CreateObject("Chilkat_9_5_0.Csv")
  19. Dim WorkingDirectory:WorkingDirectory = Replace(WScript.ScriptFullName,WScript.ScriptName,"")
  20. If dev Then
  21. DataDirectory = WorkingDirectory & "test"
  22. ExportDirectory = "\\kci-syn-cl01\PC Transfer\TrackingDataExport\"
  23. ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Jet OLEDB:Engine Type=5;Data Source=F:\Development\Tracking_Kits\Data\webdata - Copy.mdb;"
  24. PurpleEnvelopeProofReport = "F:\Development\Tracking_Kits\Data\Proofs.rep"
  25. set outFile = objFSO.CreateTextFile("\\kci-syn-cl01\PC Transfer\TrackingDataExport\temp.csv",True)
  26. Else
  27. DataDirectory = "\\kci-syn-cl01\PC Transfer\TrackingDataImport"
  28. ExportDirectory = "\\kci-syn-cl01\PC Transfer\TrackingDataExport\"
  29. ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Jet OLEDB:Engine Type=5;Data Source=C:\inetpub\Data\webdata - Copy.mdb;"
  30. PurpleEnvelopeProofReport ="C:\inetpub\tracking\Data\Proofs.rep"
  31. set outFile = objFSO.CreateTextFile("\\kci-syn-cl01\PC Transfer\TrackingDataExport\temp.csv",True)
  32. End If
  33. Dim KitID:CheckForFiles:KitID = CheckForJobsToCass()
  34. If KitID > 0 Then
  35. ExportMMCsv(KitID)
  36. RunMailManager
  37. ImportCass
  38. End If
  39. KitID = CheckForReadyToLabel():If KitID > 0 Then:createTrackingInfoForKit(KitID):End If
  40. KitID = CheckForReadyToExportToSnailWorks():If KitID > 0 Then:CreateExportForSnailWorks(KitID):End If
  41. KitID = CheckForProofReady(KitID):If KitID > 0 Then:CreateProofForJurisdiction(KitID):End If
  42. WScript.Quit
  43. Function CreateProofForJurisdiction(KitID)
  44. If oConn.State = 0 Then:oConn.Open(ConnectionString):End If
  45. Dim KitRs:set KitRs = oConn.Execute("Select * From [Kit] Where [ID] =" & KitID & ";")
  46. Dim JurisdictionRs:set JurisdictionRs = oConn.Execute("SELECt * FROM [Jurisdiction] WHERE JCode='" & KitRs("Jcode").Value & "';")
  47. Dim ProofFileName:ProofFileName = objFSO.GetBaseName(KitRs("Filename")) & "-PROOF.PDF"
  48. If Not objFSO.FolderExists(ExportDirectory & KitRs("JobNumber").Value & "-" & JurisdictionRs("Name").value) Then:objFSO.CreateFolder(ExportDirectory & KitRs("JobNumber").Value & "-" & JurisdictionRs("Name").value):End If
  49. Dim reportManager:set reportManager = CreateObject("ReportMan.ReportManX")
  50. reportManager.Preview = False
  51. reportManager.ShowProgress = False
  52. reportManager.ShowPrintDialog = False
  53. reportManager.filename = PurpleEnvelopeProofReport
  54. reportManager.SetDatabaseConnectionString "WEBDATA",ConnectionString
  55. reportManager.SetParamValue "PBKITID",KitID
  56. reportManager.SetParamValue "PBJCODE",KitRs("Jcode").Value
  57. reportManager.SaveToPDF ExportDirectory & KitRs("JobNumber").Value & "-" & JurisdictionRs("Name").value & "/" & ProofFileName,1
  58. oConn.Execute("UPDATE KIT SET [Status] ='Ready For Inkjet Export',[ExportedToSnailWorks] =#" & Now() & "# WHERE [ID] =" & KitID & ";")
  59. If KitRs.State = 1 Then:KitRs.Close:End If
  60. If JurisdictionRs.State = 1 Then:JurisdictionRs.Close:End If
  61. If oConn.State = 1 Then:oConn.Close:End If
  62. End Function
  63. Function CheckForProofReady(KitID)
  64. If oConn.State = 0 Then:oConn.Open(ConnectionString):End If
  65. Dim rs:Set rs = oConn.Execute("Select TOP 1 [ID] FROM [Kit] Where Status ='Ready to Proof' and JobType='Purple Envelopes';")
  66. If Not rs.EOF Then
  67. CheckForProofReady = rs("ID").value
  68. Else
  69. CheckForProofReady = 0
  70. End If
  71. If rs.State = 1 Then:rs.Close:End If
  72. If oConn.State = 1 Then:oConn.Close:End If
  73. End Function
  74. Function CheckForReadyToExportToSnailWorks()
  75. If oConn.State = 0 Then:oConn.Open(ConnectionString):End If
  76. Dim rs:Set rs = oConn.Execute("Select TOP 1 [ID] FROM [Kit] Where Status ='Ready For Export' and JobType='Purple Envelopes';")
  77. If Not rs.EOF Then
  78. CheckForReadyToExportToSnailWorks = rs("ID").value
  79. Else
  80. CheckForReadyToExportToSnailWorks = 0
  81. End If
  82. If rs.State = 1 Then:rs.Close:End If
  83. If oConn.State = 1 Then:oConn.Close:End If
  84. End Function
  85. Function CreateExportForSnailWorks(KitID)
  86. If oConn.State = 0 Then:oConn.Open(ConnectionString):End If
  87. Dim KitRs:set KitRs = oConn.Execute("Select * From [Kit] Where [ID] =" & KitID & ";")
  88. Dim KitLabelsRs: Set KitLabelsRs = oConn.Execute("SELECT InkjetRecords.ID, InkjetRecords.KitID, InkjetRecords.VOTERID, InkjetRecords.LASTNAME," &_
  89. " InkjetRecords.FIRSTNAME, InkjetRecords.MIDDLENAME, InkjetRecords.SUFFIX, InkjetRecords.PRECINCT," &_
  90. " InkjetRecords.ADDRESS1, InkjetRecords.ADDRESS2, InkjetRecords.ADDRESS3, InkjetRecords.ADDRESS4," &_
  91. " InkjetRecords.ADDRESS5, InkjetRecords.APPSENT, InkjetRecords.APPRETURNED, InkjetRecords.BALSENT," &_
  92. " InkjetRecords.BALRETURNED, InkjetRecords.CountingBoard, InkjetRecords.UOCAVASTATUS, InkjetRecords.EMAILADDRESS," &_
  93. " InkjetRecords.PHONENUMBER, InkjetRecords.BALLOT_NUMBER, InkjetRecords.CassADDRESS1, InkjetRecords.CassADDRESS2," &_
  94. " InkjetRecords.CassADDRESS3, InkjetRecords.CassADDRESS4, InkjetRecords.CassADDRESS5, InkjetRecords.KitLabelID," &_
  95. " KitLabels.ID, KitLabels.KitID, KitLabels.OutboundSerial, KitLabels.InBoundSerial, KitLabels.OutboundIMB," &_
  96. " KitLabels.InBoundIMB, KitLabels.OutboundIMBDigits, KitLabels.InBoundIMBDigits, KitLabels.OutboundIMBPNG," &_
  97. " KitLabels.INBOUNDIMBPNG, KitLabels.SetNumber" &_
  98. " FROM InkjetRecords" &_
  99. " LEFT JOIN [KitLabels] ON InkjetRecords.KitLabelID = KitLabels.ID" & _
  100. " WHERE InkjetRecords.KitID =" & KitID & " ;")
  101. Dim JurisdictionRs:Set JurisdictionRs = oConn.Execute("SELECT * FROM Jurisdiction WHERE JCode ='" & KitRs("Jcode").Value & "';")
  102. Dim ExportFileName:ExportFileName = objFSO.GetBaseName(KitRs("Filename")) & "_SW_EXPORT"
  103. If Not objFSO.FolderExists(ExportDirectory & KitRs("JobNumber").Value & "-" & JurisdictionRs("Name").value) Then:objFSO.CreateFolder(ExportDirectory & KitRs("JobNumber").Value & "-" & JurisdictionRs("Name").value):End If
  104. If objFSO.FileExists(ExportDirectory & KitRs("JobNumber").Value & "-" & JurisdictionRs("Name").value & "/" & ExportFileName) Then:objFSO.DeleteFile(ExportDirectory & KitRs("JobNumber").Value & "-" & JurisdictionRs("Name").value & "/" & ExportFileName):End If
  105. Dim objExportFile:set objExportFile = objFSO.CreateTextFile(ExportDirectory & KitRs("JobNumber").Value & "-" & JurisdictionRs("Name").value & "/" & ExportFileName,2)
  106. With objExportFile
  107. .Write("H") 'Record Type Required value must be = "H" (Header)
  108. .Write(PadString("5.1",5)) 'Version Required value must be ="5.1" for current release
  109. .Write(PadString("KCI",50)) 'UserId Required
  110. .Write(PadString(JurisdictionRs("Name").Value,50)) 'Client Name Required (will create new subaccount if not already defined)
  111. .Write(PadString("",50)) 'Parent Client Name Optional (use if 3-tier account structure)
  112. .Write(PadString("Purple envelope - " & KitRs("JobNumber").Value,50)) 'Job Name Required
  113. .Write(PadString("",50)) 'Job Description Optional
  114. .Write(PadString("",50)) 'Split Name Optional will default to Default
  115. .Write(PadString("",80)) 'Split Description Optional
  116. .Write(PadString("L",1)) 'Piece Type Required L-Letters, C-Cards, F-Flats
  117. .Write(PadString(Year(Now()) & "/" &_
  118. Right("0" & Month(Now()), 2) & "/" & Right("0" & Day(Now()), 2),10)) 'MailDate Required (YYYY/MM/DD)
  119. .Write(PadString("N",1)) 'UploadType Required N = New job, new split A = Append new split to existing job R = Replace existing split
  120. .Write(PadString("",8)) 'TrackedQuantity Optional
  121. .Write(PadString("",8)) 'PiecesMailed Optional shown as Estimated Quantity
  122. .Write(PadString("",10)) 'Target InHomeDateStart Optional (YYYY/MM/DD)
  123. .Write(PadString("",10)) 'Target InHomeDateEnd Optional (YYYY/MM/DD)
  124. .Write(PadString("",100)) 'ConfirmationEmail Optional
  125. .Write(PadString("",9)) 'JobId (SW) Optional for previously created jobs SWJobId
  126. .Write(PadString("",4)) 'SplitId (SW) Optional for previously created jobs SWJobId
  127. .Write(PadString(Choice(IsNull(KitRs("InboundSTID")),"O","R"),1)) 'TypeofTracking Required Values: O- Outbound Only I-Inbound Only R-Round Trip
  128. .Write(PadString("",11)) 'ReturnedPostalRoutingCode
  129. .Write(PadString("",2)) 'ReportId1
  130. .Write(PadString("",255)) 'Report1Email
  131. .Write(PadString("",2)) 'ReportId2
  132. .Write(PadString("",255)) 'Report2Email
  133. .Write(vbCrLf)
  134. While Not KitLabelsRs.EOF
  135. .Write("D") 'RecordType Required value must be = D (Detail)
  136. .Write(PadString("",20)) 'CustomerUniqueIdentifier Optional- any identifier you designate
  137. .Write(PadString(KitLabelsRs("OutboundIMBDigits"),31)) 'IMB Required Unencoded, numeric IMB
  138. .Write(PadString("",10)) 'Greeting Optional
  139. .Write(PadString("",50)) 'First Name Optional
  140. .Write(PadString("",2)) 'MI Optional
  141. .Write(PadString("",50)) 'Last Name Optional
  142. .Write(PadString("",10)) 'Suffix Optional
  143. .Write(PadString((KitLabelsRs("CassADDRESS1").Value),100)) 'Full Name Optional
  144. .Write(PadString("",50)) 'Company Optional
  145. .Write(PadString("",50)) 'Title Optional
  146. .Write(PadString(KitLabelsRs("CassADDRESS3").Value,128)) 'Address1 Optional
  147. .Write(PadString(KitLabelsRs("CassADDRESS4").Value,128)) 'Address2 Optional
  148. .Write(PadString(Left(KitLabelsRs("CassADDRESS5").Value, _
  149. InStr(KitLabelsRs("CassADDRESS5").Value, ",") - 1),50)) 'City Optional
  150. .Write(PadString(Mid(KitLabelsRs("CassADDRESS5").Value, _
  151. InStr(KitLabelsRs("CassADDRESS5").Value, ",") + 2, 2),2)) 'State Optional
  152. .Write PadString(Right(KitLabelsRs("CassADDRESS5").Value,11),11) 'Zip Optional
  153. .Write(PadString(KitRs("Jcode"),100)) 'UserDefined1 Optional - Summary fields only
  154. .Write(PadString("",100)) 'UserDefined2 Optional - Summary fields only
  155. .Write(PadString("",100)) 'UserDefined3 Optional - Summary fields only
  156. .Write(PadString(KitLabelsRs("PRECINCT").Value &_
  157. KitLabelsRs("BALLOT_NUMBER"),80)) 'UserDefinedIdentifier4 Optional Allows for unique identifiers
  158. .Write(PadString(KitLabelsRs("VOTERID").Value,80)) 'UserDefinedIdentifier5 Optional Allows for unique identifiers
  159. .Write(PadString("",1)) 'SeedIndicator Optional - if true provide Y
  160. .Write(PadString("",80)) 'InductionPoint Optional
  161. .Write(PadString("",10)) 'InductionDate Optional Valid date format, ex. MM/DD/YYYY
  162. .Write(PadString(Choice(IsNull(KitRs("InboundSTID")),"", _
  163. KitLabelsRs("InBoundIMBDigits").Value),31)) 'InboundIMB Optional numeric IMB for Round trip jobs only
  164. .Write(PadString("",24)) 'IMCB Optional Container Barcode
  165. .Write(PadString("",24)) 'IMTB Optional Tray Barcode
  166. .Write(vbCrLf)
  167. KitLabelsRs.MoveNext
  168. Wend
  169. .Close
  170. End With
  171. oConn.Execute("UPDATE KIT SET [Status] ='Ready to Proof',[ExportedToSnailWorks] =#" & Now() & "# WHERE [ID] =" & KitID & ";")
  172. If KitRs.State = 1 Then:KitRs.Close:End If
  173. If KitLabelsRs.State = 1 Then:KitLabelsRs.Close: End If
  174. If JurisdictionRs.State = 1 Then:JurisdictionRs.Close:End If
  175. If oConn.State = 1 Then:oConn.Close:End If
  176. End Function
  177. Function createTrackingInfoForKit(KitID)
  178. Dim KitRs:set KitRs = oConn.Execute("Select * from Kit Where ID =" & KitID & ";")
  179. Dim InkjetRs:Set InkjetRs = oConn.Execute("Select * from InkjetRecords Where KitID =" & KitID & ";")
  180. 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
  181. Dim SerialNumberStart:SerialNumberStart = GetSetting("SerialNumberStart")
  182. Dim serialOffset:serialOffset = GetSetting("SerialOffset")
  183. Dim serialStart:serialStart = CLng(GetSetting("SerialNumberStart")) + CLng(GetSetting("SerialOffset"))
  184. Dim Counter:Counter=0
  185. Dim KitLabelID
  186. Dim KitLabelRs
  187. Dim Step : If KitRs("InboundSTID") <> "" Then : Step = 2 : Else Step = 1
  188. serialStart = PadLeft(serialStart + CLng(Counter),9,"0")
  189. While Not InkjetRs.EOF
  190. If Step = 1 Then
  191. oConn.Execute("INSERT INTO KitLabels (KitID,OutboundSerial,OutboundIMBDigits) " &_
  192. "VALUES(" & KitID & ",'" & serialStart & "','" & KitRs("OutBoundSTID").Value & serialStart & "000000000" & "');")
  193. Else
  194. oConn.Execute "INSERT INTO KitLabels (KitID,OutboundSerial,InBoundSerial,OutboundIMBDigits,InBoundIMBDigits) " &_
  195. "VALUES(" & KitID & ",'" & serialStart & "','" & serialStart + 1 & "','" & KitRs("OutBoundSTID").Value & serialStart & "000000000" & "','" & KitRs("InboundSTID").Value & serialStart + 1 & Jcode & "');"
  196. End If
  197. Set KitLabelRs = oConn.Execute("SELECT TOP 1 [ID] FROM KitLabels ORDER BY ID DESC"):KitLabelID = KitLabelRs("ID").Value
  198. oConn.Execute("UPDATE InkjetRecords Set [KitLabelID]=" & KitLabelID & " WHERE ID=" & InkjetRs("ID") & ";")
  199. Counter = Counter + Step
  200. serialStart = serialStart + Step
  201. InkjetRs.MoveNext
  202. Wend
  203. oConn.Execute("UPDATE Settings Set [Value]='" & serialOffset + Counter & "' WHERE [Name] = 'SerialOffset';")
  204. oConn.Execute("UPDATE Kit Set [Status]='Ready For Export', LabelsPrinted=#" & Now() & "# WHERE [ID] =" & KitID &";")
  205. End Function
  206. Function GetSetting(settingName)
  207. Dim rs:Set rs = oConn.Execute("Select Value From [Settings] Where [Name] = '" & settingName & "';")
  208. If Not rs.EOF Then
  209. GetSetting = rs(0).value
  210. rs.Close
  211. Else
  212. SetSetting = 0
  213. rs.Close
  214. End If
  215. End Function
  216. Function CheckForReadyToLabel()
  217. Dim rs : set rs = oConn.Execute("Select TOP 1 ID from Kit Where Status ='Ready to Assign Labels' ORDER BY ID DESC;")
  218. If Not rs.EOF Then
  219. Dim kitId : kitId = rs("ID").value
  220. rs.Close
  221. CheckForReadyToLabel = KitID
  222. oConn.Execute("UPDATE Kit SET Status ='Applying Serial Numbers' WHERE ID =" & KitID & ";")
  223. Else
  224. CheckForReadyToLabel = 0
  225. End If
  226. End Function
  227. Function CheckForFiles()
  228. If objFSO.FolderExists(DataDirectory) Then
  229. Dim objFolder:Set objFolder = objFSO.GetFolder(DataDirectory)
  230. If objFolder.Files.Count > 0 Then
  231. 'WScript.Echo "Files found in directory: " & DataDirectory
  232. Dim objFile
  233. For Each objFile In objFolder.Files
  234. Dim CsvString:CsvString = ConvertCsvToString(objFile.Path)
  235. If ValidImportCSV(CsvString) Then
  236. SetupKit CsvString,objFile.Name
  237. objFSO.MoveFile objFile.Path, DataDirectory & "\import\" & objFile.Name
  238. End If
  239. Next
  240. Else
  241. 'WScript.Echo "No files found in directory: " & DataDirectory
  242. End If
  243. End If
  244. End Function
  245. Function ValidJcode(jcode)
  246. Dim oConn
  247. Set oConn = WScript.CreateObject("ADODB.Connection")
  248. oConn.ConnectionString = ConnectionString
  249. oConn.Open
  250. Dim oRs
  251. set oRs = oConn.Execute("Select * from Jurisdiction Where [JCode] = '" & jcode & "';")
  252. If oRs.EOF Then
  253. ValidJcode = 0
  254. Else
  255. ValidJcode = 1
  256. End If
  257. oRs.Close
  258. oConn.Close
  259. End Function
  260. Function SetupKit(CsvString,FileName)
  261. Dim JobNumber:JobNumber = Mid(FileName,9,6)
  262. Dim JCode:JCode = Left(Filename,5)
  263. If IsNumeric(JobNumber) Then
  264. If ValidJcode(JCode) Then
  265. WScript.Echo FileName & " Is a Valid CSV for Importing"
  266. Dim oConn:Set oConn = WScript.CreateObject("ADODB.Connection")
  267. oConn.ConnectionString = ConnectionString
  268. oConn.Open
  269. oConn.Execute("Insert Into Kit ([JobNumber], [Jcode], [CreatedOn], [JobType],[Filename],[Status]) VALUES ('" & JobNumber & "','" & JCode & "',#" & Now() & "#,'Purple Envelopes','" & FileName & "','Importing');")
  270. Dim rs : set rs = oConn.Execute("Select TOP 1 ID from Kit ORDER BY ID DESC")
  271. Dim kitId : kitId = rs("ID").value
  272. rs.close
  273. Dim i
  274. For i = 1 To objCSV.NumRows -1
  275. oConn.Execute("Insert Into [InkjetRecords] (KitID,VOTERID,LASTNAME,FIRSTNAME,MIDDLENAME" & _
  276. ",SUFFIX,PRECINCT,ADDRESS1,ADDRESS2,ADDRESS3,ADDRESS4,ADDRESS5,APPSENT,APPRETURNED,BALSENT,BALRETURNED" & _
  277. ",CountingBoard,UOCAVASTATUS,EMAILADDRESS,PHONENUMBER,BALLOT_NUMBER) VALUES (" & kitId & _
  278. ",'" & Replace(objCSV.GetCell(i,0),"'","''") & _
  279. "','" & objCsv.GetCell(i,1) & _
  280. "','" & Replace(objCSV.GetCell(i,2),"'","''") & _
  281. "','" & Replace(objCSV.GetCell(i,3),"'","''") & _
  282. "','" & Replace(objCSV.GetCell(i,4),"'","''") & _
  283. "','" & Replace(objCSV.GetCell(i,5),"'","''") & _
  284. "','" & Replace(objCSV.GetCell(i,6),"'","''") & _
  285. "','" & Replace(objCSV.GetCell(i,7),"'","''") & _
  286. "','" & Replace(objCSV.GetCell(i,8),"'","''") & _
  287. "','" & Replace(objCSV.GetCell(i,9),"'","''") & _
  288. "','" & Replace(objCSV.GetCell(i,10),"'","''") & _
  289. "','" & Replace(objCSV.GetCell(i,11),"'","''") & _
  290. "','" & Replace(objCSV.GetCell(i,12),"'","''") & _
  291. "','" & Replace(objCsv.GetCell(i,13),"'","''") & _
  292. "','" & objCsv.GetCell(i,14) & _
  293. "','" & objCsv.GetCell(i,15) & _
  294. "','" & objCsv.GetCell(i,16) & _
  295. "','" & objCsv.GetCell(i,17) & _
  296. "','" & objCsv.GetCell(i,18) & _
  297. "','" & objCsv.GetCell(i,19) & _
  298. "')")
  299. Next
  300. oConn.Execute("Update Kit SET [Status] = 'Ready to Cass' Where ID = " & kitId &";")
  301. 'oConn.Close
  302. End If
  303. End If
  304. End Function
  305. Function ConvertCsvToString(FilePath)
  306. Dim objFSO:Set objFSO = CreateObject("Scripting.FileSystemObject")
  307. Dim objCsvFile:set objCsvFile = objFSO.OpenTextFile(FilePath)
  308. Dim strContent:strContent = ""
  309. Dim intLineCount:intLineCount = 0
  310. Do Until objCsvFile.AtEndOfStream Or intLineCount >= 3
  311. objCsvFile.SkipLine
  312. intLineCount = intLineCount + 1
  313. Loop
  314. ' Read the remaining content into a string
  315. Do Until objCsvFile.AtEndOfStream
  316. Dim strLine:strLine = objCsvFile.ReadLine
  317. strContent = strContent & strLine & vbCrLf
  318. Loop
  319. ConvertCsvToString = strContent
  320. End Function
  321. Function ValidImportCSV(CsvFileAsString)
  322. objCSV.LoadFromString(CsvFileAsString)
  323. If objCSV.NumColumns = 20 Then
  324. debug.WriteLine objCsv.GetCell(1,1)
  325. ValidImportCSV = True
  326. Else
  327. ValidImportCSV = False
  328. End If
  329. End Function
  330. Sub ImportCass
  331. Dim currentRow
  332. objCsv.LoadFile("\\kci-syn-cl01\PC Transfer\TrackingDataExport\FROM_MM.CSV")
  333. For currentRow = 0 To objCsv.NumRows -1
  334. oConn.Execute("UPDATE InkJetRecords SET CassADDRESS1 = '" & Replace(objCsv.GetCell(currentRow,1),"'","''") & "', " &_
  335. "CassADDRESS2 = '" & Replace(objCSV.GetCell(currentRow,3),"'","''") & "', " &_
  336. "CassADDRESS3 = '" & Replace(objCSV.GetCell(currentRow,4),"'","''") & "', " &_
  337. "CassADDRESS4 = '" & Replace(objCSV.GetCell(currentRow,5),"'","''") & "', " &_
  338. "CassADDRESS5 = '" & Replace(objCsv.GetCell(currentRow,6) & ", " & objCsv.GetCell(currentRow,7) & " " & objCsv.GetCell(currentRow,8),"'","''") & "'" &_
  339. " WHERE ID = " & objCSV.GetCell(currentRow,0) & ";")
  340. Next
  341. oConn.Execute("UPDATE Kit SET Status ='Ready To Assign STIDS' WHERE ID =" & KitID & ";")
  342. oConn.Execute("UPDATE Kit SET [Cass] = 1 WHERE ID =" & KitID & ";")
  343. End Sub
  344. Sub RunMailManager
  345. 'WshShell.Run "\\MM2012\APPS\BCC\MM2010\mailman.exe -p -j MMJOB.mjb -u DAN",1,True
  346. 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
  347. End Sub
  348. Sub ExportMMCsv(KitId)
  349. Dim success
  350. objCsv.HasColumnNames = 1
  351. objCSV.EnableQuotes = 1
  352. success = objCsv.SetColumnName(0,"ID")
  353. success = objCsv.SetColumnName(1,"NAME")
  354. success = objCsv.SetColumnName(2,"ADDRESS1")
  355. success = objCsv.SetColumnName(3,"ADDRESS2")
  356. success = objCsv.SetColumnName(4,"ADDRESS3")
  357. success = objCsv.SetColumnName(5,"ADDRESS4")
  358. success = objCsv.SetColumnName(6,"ADDRESS5")
  359. Dim rs : Set rs = oConn.Execute("Select ID," & _
  360. "IIF(FIRSTNAME IS NULL,'',FIRSTNAME & ' ') & " & _
  361. "IIF(MIDDLENAME IS NULL,'',MIDDLENAME & ' ') & " & _
  362. "IIF(LASTNAME IS NULL,'',LASTNAME & ' ') & " & _
  363. "IIF(SUFFIX IS NULL,'',SUFFIX & ' ') " & _
  364. "AS NAME, ADDRESS1,ADDRESS2,ADDRESS3,ADDRESS4,ADDRESS5 FROM InkjetRecords WHERE KitID =" & KitID & " ORDER By ID;")
  365. Dim CurrentRow:CurrentRow = 0
  366. While Not rs.EOF
  367. objCSV.SetCell CurrentRow,0,rs("ID").value
  368. objCSV.SetCell CurrentRow,1,rs("NAME").value
  369. objCSV.SetCell CurrentRow,2,rs("ADDRESS1").value
  370. objCSV.SetCell CurrentRow,3,rs("ADDRESS2").value
  371. objCSV.SetCell CurrentRow,4,rs("ADDRESS3").value
  372. objCSV.SetCell CurrentRow,5,rs("ADDRESS4").value
  373. objCSV.SetCell CurrentRow,6,rs("ADDRESS5").value
  374. rs.MoveNext
  375. CurrentRow = CurrentRow +1
  376. Wend
  377. Dim CsvString:CsvString = objCSV.SaveToString()
  378. outFile.WriteLine CsvString
  379. outFile.Close
  380. End Sub
  381. Function CheckForJobsToCass()
  382. oConn.ConnectionString = ConnectionString
  383. oConn.Open
  384. 'oConn.Open
  385. Dim rs : set rs = oConn.Execute("Select TOP 1 ID from Kit Where Status ='Ready to Cass' ORDER BY ID DESC;")
  386. If Not rs.EOF Then
  387. Dim kitId : kitId = rs("ID").value
  388. rs.Close
  389. CheckForJobsToCass = KitID
  390. oConn.Execute("UPDATE Kit SET Status ='Cassing' WHERE ID =" & KitID & ";")
  391. Else
  392. CheckForJobsToCass = 0
  393. End If
  394. 'oConn.Close
  395. End Function
  396. Public Function PadLeft(originalString,desiredLength,Char)
  397. Dim padLength
  398. padLength = desiredLength - Len(originalString)
  399. If padLength > 0 Then
  400. ' Left pad the string with zeros
  401. PadLeft = String(padLength, Char) & originalString
  402. Else
  403. ' If the original string is already longer or equal to the desired length, no padding is needed
  404. PadLeft = originalString
  405. End If
  406. End Function
  407. Function PadString(inputString, size)
  408. Dim paddedString
  409. Dim inputLength
  410. Dim i
  411. ' Get the length of the input string
  412. inputLength = Len(inputString)
  413. ' If the input string is already equal to or longer than the specified size, return it as is
  414. If inputLength >= size Then
  415. PadString = inputString
  416. Exit Function
  417. End If
  418. ' Initialize the padded string with the input string
  419. paddedString = inputString
  420. ' Pad spaces to the right of the input string until it reaches the specified size
  421. For i = 1 To (size - inputLength)
  422. paddedString = paddedString & " "
  423. Next
  424. ' Return the padded string
  425. PadString = paddedString
  426. End Function
  427. Public Sub Assign(ByRef var, ByVal val)
  428. If IsObject(val) Then
  429. Set var = val
  430. Else
  431. var = val
  432. End If
  433. End Sub
  434. Public Function Choice(ByVal cond, ByVal if_true, ByVal if_false)
  435. If cond Then
  436. Assign Choice, if_true
  437. Else
  438. Assign Choice, if_false
  439. End If
  440. End Function

Powered by TurnKey Linux.