Option Explicit ' -- ADODB constants ---------------------------------------------------------- Const adCmdText = 1 Const adParamInput = 1 Const adInteger = 3 Const adDate = 7 Const adVarChar = 200 Const adLongVarChar = 201 ' -- Locate web.config --------------------------------------------------------- Dim scriptDir scriptDir = Left(WScript.ScriptFullName, InStrRev(WScript.ScriptFullName, "\")) Dim webConfigPath webConfigPath = scriptDir & "..\public\web.config" ' -- Read a key from web.config ---------------------------------- Function ReadWebConfig(key) Dim xml : Set xml = CreateObject("MSXML2.DOMDocument.6.0") xml.async = False xml.load webConfigPath If xml.parseError.errorCode <> 0 Then WScript.Echo "ERROR: Cannot parse web.config: " & xml.parseError.reason WScript.Quit 1 End If Dim node : Set node = xml.selectSingleNode("//add[@key='" & key & "']") If node Is Nothing Then ReadWebConfig = "" Else ReadWebConfig = node.getAttribute("value") End If Set xml = Nothing End Function ' -- Escape single quotes for inline SQL (admin-controlled input only) --------- Function EscSQL(s) EscSQL = Replace(CStr(s), "'", "''") End Function ' -- Derive ACE OLE DB connection string from the ODBC ConnectionString -------- Dim odbcStr : odbcStr = ReadWebConfig("ConnectionString") Dim dbqPath : dbqPath = "" Dim odbcParts, i odbcParts = Split(odbcStr, ";") For i = 0 To UBound(odbcParts) Dim p : p = Trim(odbcParts(i)) If LCase(Left(p, 4)) = "dbq=" Then dbqPath = Trim(Mid(p, 5)) Exit For End If Next If dbqPath = "" Then WScript.Echo "ERROR: Could not find Dbq= path in ConnectionString." WScript.Quit 1 End If Dim accessConnStr : accessConnStr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dbqPath & ";" Dim psConnStr : psConnStr = ReadWebConfig("PrintStreamConnectionString") If psConnStr = "" Or InStr(psConnStr, "YOUR_SERVER") > 0 Then WScript.Echo "ERROR: PrintStreamConnectionString is not configured in web.config." WScript.Quit 1 End If ' -- Open connections ---------------------------------------------------------- Dim cnAccess : Set cnAccess = CreateObject("ADODB.Connection") On Error Resume Next cnAccess.Open accessConnStr If Err.Number <> 0 Then WScript.Echo "ERROR opening Access database: " & Err.Description WScript.Quit 1 End If On Error GoTo 0 Dim cnPS : Set cnPS = CreateObject("ADODB.Connection") On Error Resume Next cnPS.Open psConnStr If Err.Number <> 0 Then WScript.Echo "ERROR opening PrintStream database: " & Err.Description cnAccess.Close WScript.Quit 1 End If On Error GoTo 0 WScript.Echo "Connected to both databases." WScript.Echo "" ' -- PrintStream query template (CTEs + outer SELECT) -------------------------- ' A WHERE clause filtering on e2.[DETAILS1] (JobName) is appended per token. Dim psSqlBase psSqlBase = _ ";WITH OpenProcess AS (" & _ "SELECT s.[JOB NUMBER] AS JOB_NUMBER, cc.[DEPT] AS Department," & _ " s.[COMPLETED], s.[CLOSED OUT] AS CLOSED_OUT," & _ " ISNULL(s.[FILETYPE],'') AS FILETYPE," & _ " ISNULL(s.[STATUS],'') AS [STATUS]," & _ " e.[DEBTOR], e.[DETAILS1], e.[DELIVERY DATE] AS DELIVERY_DATE," & _ " s.[ACTIVITY NO]" & _ " FROM dbo.SCHEDFIL AS s" & _ " JOIN dbo.ESTIMATE AS e ON e.[DATAFLEX RECNUM ONE] = s.[ESTIMATE RECNUM]" & _ " JOIN dbo.CostCenters AS cc ON cc.[Code] = s.[COST CENTRE]" & _ " WHERE ISNULL(s.[COMPLETED],'') <> 'Y'" & _ " AND ISNULL(s.[CLOSED OUT],'') <> 'Y'" & _ " AND ISNULL(e.[CLOSED OUT],'') <> 'Y'" & _ " AND e.[DELIVERY DATE] > DATEADD(DAY,-365,CAST(GETDATE() AS date))" & _ " AND s.[FILETYPE] IN ('D','Q','X','I','W','R','T','P')" & _ " AND (s.[STATUS] IN ('*','6','7','0','1','2','3','4','5',' ') OR s.[STATUS] IS NULL)" & _ ")," & _ "AggNotes AS (" & _ "SELECT n.[RELATED TO]," & _ " STUFF((" & _ " SELECT ISNULL(n2.[NOTE], '')" & _ " FROM dbo.NOTES AS n2" & _ " WHERE n2.[RELATED TO] = n.[RELATED TO]" & _ " AND n2.[MODULE] = 'MDP'" & _ " ORDER BY TRY_CAST(n2.[LINE NO] AS INT)" & _ " FOR XML PATH(''), TYPE" & _ " ).value('.','NVARCHAR(MAX)'),1,0,'') AS FullNote" & _ " FROM dbo.NOTES AS n" & _ " WHERE n.[MODULE] = 'MDP'" & _ " GROUP BY n.[RELATED TO]" & _ ")" & _ " SELECT DISTINCT" & _ " op.JOB_NUMBER AS JobNumber," & _ " d.[NAMES] AS CustomerName," & _ " e2.[DETAILS1] AS JobName," & _ " e2.[FINAL DELIVERY] AS FinalDelivery," & _ " e2.[ORIG_Qty1] AS Quantity," & _ " CONCAT(e2.[DETAILS2],e2.[DETAILS3],e2.[DETAILS4],e2.[DETAILS5]," & _ " e2.[DETAILS6],e2.[DETAILS7],e2.[DETAILS8],e2.[DETAILS9],e2.[DETAILS10]) AS Notes," & _ " an.FullNote" & _ " FROM OpenProcess AS op" & _ " LEFT JOIN dbo.DEBTOR AS d ON op.[DEBTOR] = d.[AC NO]" & _ " LEFT JOIN dbo.ESTIMATE AS e2 ON op.JOB_NUMBER = e2.[JOB NUMBER]" & _ " LEFT JOIN AggNotes AS an ON e2.[ORIG_QuoteNo] = an.[RELATED TO]" ' -- Helper: get a safe string from a potentially-null recordset field --------- Function SafeStr(val) If IsNull(val) Then SafeStr = "" Else SafeStr = CStr(val) End Function ' -- Process each PrintStream-enabled board ------------------------------------ Dim rsBds : Set rsBds = cnAccess.Execute( _ "SELECT [id],[printstream_job_name] FROM [boards] WHERE [import_from_printstream] = True") Dim totalBoards : totalBoards = 0 Dim totalCreated : totalCreated = 0 Dim totalUpdated : totalUpdated = 0 Do While Not rsBds.EOF Dim boardId : boardId = CLng(rsBds("id")) Dim filterMemo : filterMemo = SafeStr(rsBds("printstream_job_name")) totalBoards = totalBoards + 1 WScript.Echo "Board ID " & boardId & ":" ' -- Get first column and first swim lane ---------------------------------- Dim firstColId : firstColId = 0 Dim firstLaneId : firstLaneId = 0 Dim rsCol : Set rsCol = cnAccess.Execute( _ "SELECT TOP 1 [id] FROM [board_columns] WHERE [board_id]=" & boardId & " ORDER BY [position]") If Not rsCol.EOF Then firstColId = CLng(rsCol("id")) rsCol.Close : Set rsCol = Nothing Dim rsLane : Set rsLane = cnAccess.Execute( _ "SELECT TOP 1 [id] FROM [swim_lanes] WHERE [board_id]=" & boardId & " ORDER BY [position]") If Not rsLane.EOF Then firstLaneId = CLng(rsLane("id")) rsLane.Close : Set rsLane = Nothing If firstColId = 0 Or firstLaneId = 0 Then WScript.Echo " No columns or swim lanes found - skipping." Else ' -- Parse filter tokens (one per line) -------------------------------- Dim tokenDict : Set tokenDict = CreateObject("Scripting.Dictionary") tokenDict.CompareMode = 1 ' vbTextCompare Dim tokens : tokens = Split(CStr(filterMemo), Chr(10)) Dim t For t = 0 To UBound(tokens) Dim tok : tok = Trim(Replace(CStr(tokens(t)), Chr(13), "")) If Len(tok) > 0 Then If Not tokenDict.Exists(tok) Then tokenDict.Add tok, True End If Next If tokenDict.Count = 0 Then WScript.Echo " No job name filter configured - skipping." Else ' -- Query PrintStream for each token, collect unique jobs --------- Dim jobDict : Set jobDict = CreateObject("Scripting.Dictionary") jobDict.CompareMode = 1 ' vbTextCompare - case-insensitive keys Dim tokenKeys : tokenKeys = tokenDict.Keys Dim tk For tk = 0 To UBound(tokenKeys) Dim filterSql filterSql = psSqlBase & " WHERE e2.[DETAILS1] LIKE '%" & EscSQL(tokenKeys(tk)) & "%'" Dim rsPS : Set rsPS = Nothing On Error Resume Next Set rsPS = cnPS.Execute(filterSql) If Err.Number <> 0 Then WScript.Echo " WARNING: PrintStream query failed for '" & tokenKeys(tk) & "': " & Err.Description Err.Clear Else Do While Not rsPS.EOF Dim jn : jn = SafeStr(rsPS("JobNumber")) If Len(jn) > 0 And Not jobDict.Exists(jn) Then Dim info : Set info = CreateObject("Scripting.Dictionary") info.Add "JobNumber", jn info.Add "CustomerName", SafeStr(rsPS("CustomerName")) info.Add "JobName", SafeStr(rsPS("JobName")) info.Add "Quantity", SafeStr(rsPS("Quantity")) info.Add "Notes", SafeStr(rsPS("Notes")) info.Add "FullNote", SafeStr(rsPS("FullNote")) ' Keep delivery date as a VBScript Date or Null Dim delivVal : delivVal = Null If Not IsNull(rsPS("FinalDelivery")) Then On Error Resume Next delivVal = CDate(rsPS("FinalDelivery")) If Err.Number <> 0 Then delivVal = Null : Err.Clear On Error GoTo 0 End If info.Add "DeliveryDate", delivVal jobDict.Add jn, info End If rsPS.MoveNext Loop rsPS.Close End If On Error GoTo 0 Set rsPS = Nothing Next WScript.Echo " Found " & jobDict.Count & " unique open job(s) matching filters." ' -- Insert new cards / update existing cards ---------------------- Dim jobKeys : jobKeys = jobDict.Keys Dim k For k = 0 To UBound(jobKeys) Dim jobNum : jobNum = jobKeys(k) Dim ji : Set ji = jobDict(jobNum) Dim checkSql checkSql = "SELECT COUNT(*) FROM [cards] WHERE [board_id]=" & boardId & _ " AND [job_number]='" & EscSQL(jobNum) & "'" Dim rsChk : Set rsChk = cnAccess.Execute(checkSql) Dim alreadyExists : alreadyExists = (CLng(rsChk(0)) > 0) rsChk.Close : Set rsChk = Nothing If Not alreadyExists Then ' Determine next position in the target cell Dim posSql posSql = "SELECT MAX([position]) FROM [cards] WHERE [column_id]=" & firstColId & _ " AND [swim_lane_id]=" & firstLaneId Dim rsPos : Set rsPos = cnAccess.Execute(posSql) Dim nextPos : nextPos = 0 If Not rsPos.EOF Then If Not IsNull(rsPos(0)) Then nextPos = CLng(rsPos(0)) + 1 End If rsPos.Close : Set rsPos = Nothing Dim cmd : Set cmd = CreateObject("ADODB.Command") Set cmd.ActiveConnection = cnAccess cmd.CommandType = adCmdText cmd.CommandText = _ "INSERT INTO [cards] " & _ "([board_id],[column_id],[swim_lane_id],[job_number],[job_name]," & _ "[customer_name],[delivery_date],[quantity],[notes],[full_note],[position]," & _ "[created_at],[created_by],[updated_at],[updated_by]) " & _ "VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)" Dim now_ : now_ = Now() cmd.Parameters.Append cmd.CreateParameter("", adInteger, adParamInput, , boardId) cmd.Parameters.Append cmd.CreateParameter("", adInteger, adParamInput, , firstColId) cmd.Parameters.Append cmd.CreateParameter("", adInteger, adParamInput, , firstLaneId) cmd.Parameters.Append cmd.CreateParameter("", adVarChar, adParamInput, 255, ji("JobNumber")) cmd.Parameters.Append cmd.CreateParameter("", adVarChar, adParamInput, 255, ji("JobName")) cmd.Parameters.Append cmd.CreateParameter("", adVarChar, adParamInput, 255, ji("CustomerName")) ' Nullable delivery_date Dim delivParam : Set delivParam = cmd.CreateParameter("", adDate, adParamInput) If IsNull(ji("DeliveryDate")) Then delivParam.Value = Null Else delivParam.Value = ji("DeliveryDate") End If cmd.Parameters.Append delivParam cmd.Parameters.Append cmd.CreateParameter("", adVarChar, adParamInput, 50, ji("Quantity")) Dim notesVal : notesVal = CStr(ji("Notes")) Dim notesSize : notesSize = Len(notesVal) If notesSize < 1 Then notesSize = 1 cmd.Parameters.Append cmd.CreateParameter("", adLongVarChar, adParamInput, notesSize, notesVal) Dim fullNoteVal : fullNoteVal = CStr(ji("FullNote")) Dim fullNoteSize : fullNoteSize = Len(fullNoteVal) If fullNoteSize < 1 Then fullNoteSize = 1 cmd.Parameters.Append cmd.CreateParameter("", adLongVarChar, adParamInput, fullNoteSize, fullNoteVal) cmd.Parameters.Append cmd.CreateParameter("", adInteger, adParamInput, , nextPos) cmd.Parameters.Append cmd.CreateParameter("", adDate, adParamInput, , now_) cmd.Parameters.Append cmd.CreateParameter("", adVarChar, adParamInput, 255, "printstream-import") cmd.Parameters.Append cmd.CreateParameter("", adDate, adParamInput, , now_) cmd.Parameters.Append cmd.CreateParameter("", adVarChar, adParamInput, 255, "printstream-import") On Error Resume Next cmd.Execute If Err.Number <> 0 Then WScript.Echo " WARNING: Insert failed for job " & jobNum & ": " & Err.Description Err.Clear Else totalCreated = totalCreated + 1 WScript.Echo " + " & jobNum & " - " & ji("JobName") End If On Error GoTo 0 Set cmd = Nothing Else ' Refresh PrintStream fields on existing cards Dim updCmd : Set updCmd = CreateObject("ADODB.Command") Set updCmd.ActiveConnection = cnAccess updCmd.CommandType = adCmdText updCmd.CommandText = _ "UPDATE [cards] SET " & _ "[job_name]=?,[customer_name]=?,[delivery_date]=?,[quantity]=?," & _ "[notes]=?,[full_note]=?,[updated_at]=?,[updated_by]=? " & _ "WHERE [board_id]=? AND [job_number]=?" updCmd.Parameters.Append updCmd.CreateParameter("", adVarChar, adParamInput, 255, ji("JobName")) updCmd.Parameters.Append updCmd.CreateParameter("", adVarChar, adParamInput, 255, ji("CustomerName")) Dim delivUpdParam : Set delivUpdParam = updCmd.CreateParameter("", adDate, adParamInput) If IsNull(ji("DeliveryDate")) Then delivUpdParam.Value = Null Else delivUpdParam.Value = ji("DeliveryDate") End If updCmd.Parameters.Append delivUpdParam updCmd.Parameters.Append updCmd.CreateParameter("", adVarChar, adParamInput, 50, ji("Quantity")) Dim notesUpdVal : notesUpdVal = CStr(ji("Notes")) Dim notesUpdSize : notesUpdSize = Len(notesUpdVal) If notesUpdSize < 1 Then notesUpdSize = 1 updCmd.Parameters.Append updCmd.CreateParameter("", adLongVarChar, adParamInput, notesUpdSize, notesUpdVal) Dim fullNoteUpdVal : fullNoteUpdVal = CStr(ji("FullNote")) Dim fullNoteUpdSize : fullNoteUpdSize = Len(fullNoteUpdVal) If fullNoteUpdSize < 1 Then fullNoteUpdSize = 1 updCmd.Parameters.Append updCmd.CreateParameter("", adLongVarChar, adParamInput, fullNoteUpdSize, fullNoteUpdVal) updCmd.Parameters.Append updCmd.CreateParameter("", adDate, adParamInput, , Now()) updCmd.Parameters.Append updCmd.CreateParameter("", adVarChar, adParamInput, 255, "printstream-import") updCmd.Parameters.Append updCmd.CreateParameter("", adInteger, adParamInput, , boardId) updCmd.Parameters.Append updCmd.CreateParameter("", adVarChar, adParamInput, 255, jobNum) On Error Resume Next updCmd.Execute If Err.Number <> 0 Then WScript.Echo " WARNING: Update failed for job " & jobNum & ": " & Err.Description Err.Clear Else totalUpdated = totalUpdated + 1 End If On Error GoTo 0 Set updCmd = Nothing End If Next Set jobDict = Nothing End If End If rsBds.MoveNext Loop rsBds.Close : Set rsBds = Nothing cnPS.Close : Set cnPS = Nothing cnAccess.Close : Set cnAccess = Nothing WScript.Echo "" WScript.Echo "Import complete." WScript.Echo " Boards processed : " & totalBoards WScript.Echo " Cards created : " & totalCreated WScript.Echo " Cards updated : " & totalUpdated