VBS Packing Slip Application Problem
Ive created this script to create packing slips per order and list the items sold, but for some reasons items that are not matched up to the order are being added. Not sure why Ill post my code and explain:
I cant see whats wrong with it but maybe in the loop somewhere?
Ill Post all the code here, if you scroll down I marked what part of the code im having problems with, the 3rd code down.
Open that dabase and start to loop through the orders
Code:
'----------------------- Create packing Slips ---------------------------
strsheetcount = 1
xlrow = 1
master_file = "C:\Inetpub\WebSites\website\vbs\pslip-template.xls"
save_as_file = "C:\Inetpub\Batch\NB\" & strdate & "-pslip.xls"
Set xl = CreateObject("Excel.Application")
xl.Visible = False
xl.DisplayAlerts = False
xl.Interactive = False
Set wrk = xl.Workbooks.Open(master_file)
'Set wrkSht = wrk.sheets(1)
'Set to Sheet1 because that is excel default
strsql = "Select * from tb_orders where status='Step 1'"
rsitems.open strsql, adocon
Do While Not Rsitems.EOF
strsql = "UPDATE tb_orders SET Status = 'Step 2'WHERE order_ID ='" & rsitems("order_ID") & "'"
adocon.execute strsql
Set wrkSht = wrk.sheets(strsheetcount)
stritemcount = 0
Write Out the order Number Ship/Ect. This works fine
Code:
wrkSht.Cells(7, 1).Value = "#" & rsitems("order_ID")
wrkSht.Cells(8, 1).Value = "Date:"
wrkSht.Cells(9, 1).Value = "Ship to:"
wrkSht.Cells(13, 1).Value = "Via:"
wrkSht.Cells(15, 1).Value = "Item"
wrkSht.Cells(15, 8).Value = "Code"
wrkSht.Cells(15, 10).Value = "Qty"
wrkSht.Cells(7, 3).Value = "Packing Slip " & rsitems("order_ID") & " for websitecom"
wrkSht.Cells(8, 3).Value = now
wrkSht.Cells(9, 3).Value = rsitems("s_firstname") & " " & rsitems("s_lastname")
wrkSht.Cells(10, 3).Value = rsitems("s_address")
wrkSht.Cells(11, 3).Value = rsitems("s_city") & " " & rsitems("s_state") & ", " & rsitems("s_zip")
wrkSht.Cells(13, 3).Value = strshipping_method
This is where im running into the problem, it selects the order number then opens the sold table and selects everything from that order, but its selecting extra items to.
Code:
strsql2 = "Select * from tb_sold where order_id='" & rsitems("order_ID") & "'"
rsitems2.open strsql2, adocon
Do While Not Rsitems2.EOF
wrkSht.Cells(16 + cint(stritemcount), 1).Value = rsitems2("Item_Name")
wrkSht.Cells(17 + cint(stritemcount), 1).Value = "http://www.website.com/item.asp?itemnum=" & rsitems2("Item_ID")
wrkSht.Cells(16 + cint(stritemcount), 8).Value = rsitems2("Item_ID")
wrkSht.Cells(16 + cint(stritemcount), 10).Value = rsitems2("qty")
stritemcount = stritemcount + 2
rsitems2.movenext
loop
xlrow = xlrow + 1
rsitems2.close
rsitems.movenext
If NOT rsItems.EOF then 'IF THERE IS ANOTHER RECORD, COPY/PASTE
This checks to see if theres another order and adds another sheet because excels default is 3 pages, if anymore orders then 3, i gotta add another page
Code:
'----------------------------------------------------------------------------------------
' PASTE NEW SHEET
'-----------------------------------------------------------------------------------------
strsheetcount = strsheetcount + 1
If strsheetcount > 3 Then
'wrk.sheets.add()
wrk.sheets.add ,wrk.sheets(wrk.sheets.count)
end if
'Set sh = wrk.Sheets.Add(, wrk.Sheets(wrk.Sheets.Count))
'With sh.Range("A1").Borders(xlEdgeBottom)
'.LineStyle = xlContinuous
'.Weight = xlThin
'.ColorIndex = xlAutomatic
'End With
'Set wrkSht = wrk.sheets("Sheet1") 'SELECT THE ORIGINAL
wrk.sheets("Sheet1").Select
wrkSht.Cells.Copy 'COPY CELLS FROM 1st
Set wrkSht = wrk.sheets("Sheet" & strsheetcount) 'Set 2nd wrkSht object to sheet2
'wrkSht.Cells.Select
wrkSht.Paste 'Paste the copied text
xl.CutCopyMode = False 'I have no idea what this means
End If
loop
rsitems.close
adocon.close
set rsitems = nothing
set rsitems2 = nothing
set adocon = nothing
[code]
'----------------------------------
' SAVE MASTER FILE & QUIT
'----------------------------------
wrk.SaveAs save_as_file 'THIS SECTION CAN BE USED TO SET FILE TYPE
Save The Excel File
Save & Quit
Code:
'----------------------------------------------------------------------------
' DIFFERENT FILE TYPES
'------------------------------------------------------------------------------
'wrk.SaveAs ave_as_file, -4158 'Save as TAB DELIMITED File
'wrk.SaveAs ave_as_file, 6 'Save as a CSV File
wrk.Close
Set wrkSht = Nothing
Set wrk = Nothing
xl.Quit
Set xl = Nothing
Hope ya can help,
Thank you,
Billy