Thank you so much for your replies accesstos and ranman256, i have tried a couple of things but i may well not be understanding you, hope this code posts ok
Still stalls at adding worksheet 4 as post #1, click again it will ask do you want to replace as it must have generated the file by the time it stalls then only adds first 3 sheets, on the 3rd click, adds everything correctly ????
Much much appreciate your help
Code:
Dim FldQty As Long
Dim FldName As String, DirStr As String, mBody As String, MySL As String, XLFromPath As String, XLToPath As String
Dim FldDate, NewFldDate, mDay, nDay
Dim DaysAdd, MyID, XLFromQty, XLToQty, HGBackup As Long
Dim mCurFldDate As Date
Dim MyInput As Long, Lr As Long
Dim fd As FileDialog, FileName, FldPath, DLr, DLROpen, XLNamesFrom, XLNamesTo As String
Dim vrtSelectedItem As Variant
Dim rs As DAO.Recordset, rs2 As DAO.Recordset, rs3 As DAO.Recordset, rs4 As DAO.Recordset, rs5 As DAO.Recordset, rs6 As DAO.Recordset
Dim rs7 As DAO.Recordset, rs8 As DAO.Recordset, rs9 As DAO.Recordset, rs10 As DAO.Recordset, rs11 As DAO.Recordset, rs12 As DAO.Recordset
Dim fdXLFrom As FileDialog, fdXLTo As FileDialog, fdHG1 As FileDialog, fdHG2 As FileDialog, fdHG3 As FileDialog, fdHGTo As FileDialog
Dim xlFileNameNew As String
Dim Cust As String, Src As String, MyStatus As String, mHold As String, MyStatus2 As String, MyStatus3 As String
Dim strPathName As String, FL As String, HG As String
Dim MyDate As Date
Dim ApXL As Object, xlWB As Object, wsAdd1 As Object, wsAdd2 As Object, wsAdd3 As Object
Dim wsAdd4 As Object, wsAdd5 As Object, wsAdd6 As Object, wsAdd7 As Object, wsAdd8 As Object
Dim xlApp As Excel.Application
Dim xlWS1 As Object, xlWS2 As Object, xlWS3 As Object
Dim xlWS4 As Object, xlWS5 As Object, xlWS6 As Object, xlWS7 As Object, xlWS8 As Object, xlWS9 As Object, xlWS10 As Object, xlWS11 As Object, xlWS12 As Object
Dim ToName As String, ToPath As String
Dim TimeNow As String, TOD As String, mYes As String
Dim myApp As New Outlook.Application
Dim MyItem As Outlook.MailItem
Code:
Cust = Forms!frmMainMenu!frmIndex1!cboCustomer
Src = "Acc"
MyStatus = "Planning"
MyStatus2 = "Friday"
MyStatus3 = "Monday"
mHold = "On Hold"
mYes = "Yes"
MyDate = Format(Me.txtUpdate, "mm/dd/yyyy")
Set rs = CurrentDb.OpenRecordset("SELECT tblStock.StartQty, tblStock.ProductType, tblStock.ProductNo, tblStock.PONumber, tblStock.Upholstry, tblStock.SortNo FROM tblStock ORDER BY SortNo;")
Set rs2 = CurrentDb.OpenRecordset("SELECT tblEdit.DelTo, tblEdit.Town, tblEdit.SONumber, tblEdit.PONumber, tblEdit.ProductType, tblEdit.ProductNo, tblEdit.Status FROM tblEdit WHERE Customer = '" & Cust & "'" & " And Status = '" & MyStatus & "'" & " Or Status = '" & MyStatus2 & "'" & " Or Status = '" & MyStatus3 & "'" & " And Source = '" & Src & "' ORDER BY DelTo;")
Set rs3 = CurrentDb.OpenRecordset("SELECT tblAssign.DeliveryDate, tblAssign.DelTo, tblAssign.Town, tblAssign.SONumber, tblAssign.PONumber, tblAssign.ProductType, tblAssign.ProductNo, tblAssign.Status FROM tblAssign WHERE Customer = '" & Cust & "'" & " And Source = '" & Src & "'" & " And DeliveryDate = #" & MyDate & "#" & " ORDER BY DelTo;")
Set rs4 = CurrentDb.OpenRecordset("SELECT tblCollections.CollectedDate, tblCollections.DelTo, tblCollections.Town, tblCollections.SONumber, tblCollections.PONumber, tblCollections.ProductType, tblCollections.ProductNo, tblCollections.Status FROM tblCollections WHERE Customer = '" & Cust & "'" & " And Source = '" & Src & "'" & " And Collected = Yes" & " ORDER BY DelTo;")
Set rs5 = CurrentDb.OpenRecordset("SELECT tblHold.ShipmentDate, tblHold.DelTo, tblHold.Town, tblHold.SONumber, tblHold.PONumber, tblHold.ProductType, tblHold.ProductNo, tblHold.Status FROM tblHold ORDER BY DelTo;")
Set rs6 = CurrentDb.OpenRecordset("SELECT tblAssign.DeliveryDate, tblAssign.DelTo, tblAssign.Town, tblAssign.SONumber, tblAssign.PONumber, tblAssign.ProductType, tblAssign.ProductNo, tblAssign.Status FROM tblAssign WHERE Customer = '" & Cust & "'" & " And Source = '" & Src & "'" & " ORDER BY SONumber DESC")
Set rs7 = CurrentDb.OpenRecordset("SELECT tblCollections.CollectedDate, tblCollections.DelTo, tblCollections.Town, tblCollections.SONumber, tblCollections.PONumber, tblCollections.LiftType, tblCollections.LiftNo, tblCollections.Status, tblCollections.xlRow FROM tblCollections WHERE Customer = '" & Cust & "'" & " And Source = '" & Src & "'" & " ORDER BY SONumber DESC")
Set rs8 = CurrentDb.OpenRecordset("SELECT tblAssign.ProductNo, tblAssign.SONumber, tblAssign.DelTo, tblAssign.ProductType, tblAssign.PONumber, tblAssign.Shipped, tblAssign.DeliveryDate, tblAssign.xlRow FROM tblAssign WHERE Customer = '" & Cust & "'" & " And Source = '" & Src & "'" & " And DeliveryDate = #" & MyDate & "#" & " ORDER BY xlRow;")
Set rs9 = CurrentDb.OpenRecordset("SELECT tblCollections.ProductNo, tblCollections.SONumber, tblCollections.DelTo, tblCollections.ProductType, tblCollections.PONumber, tblCollections.Shipped, tblCollections.CollectedDate, tblCollections.xlRow FROM tblCollections WHERE Customer = '" & Cust & "'" & " And Source = '" & Src & "'" & " And CollectedDate = #" & MyDate & "#" & " And Collected = Yes" & " ORDER BY xlRow;")
Code:
strPathName = "T:\My Folder\XL Files\Daily Update\"FileName = "Daily Update" & " " & Format(Me.txtUpdate, "dd-mm-yy") & ".xlsx"
Set ApXL = CreateObject("Excel.Application")
Set xlWB = ApXL.Workbooks.Add
Set xlWS1 = xlWB.Worksheets("Sheet1")
xlWS1.Name = "HG STOCK"
Set xlWS2 = xlWB.Worksheets("Sheet2")
xlWS2.Name = "DELIVERIES PENDING"
Set xlWS3 = xlWB.Worksheets("Sheet3")
xlWS3.Name = "DELIVERIES"
Set wsAdd1 = Sheets.Add(After:=Sheets(Worksheets.Count))
wsAdd1.Name = "COLLECTIONS"
Set wsAdd2 = Sheets.Add(After:=Sheets(Worksheets.Count))
wsAdd2.Name = "ON HOLD"
Set wsAdd3 = Sheets.Add(After:=Sheets(Worksheets.Count))
wsAdd3.Name = "DELIVERIES ALL"
Set wsAdd4 = Sheets.Add(After:=Sheets(Worksheets.Count))
wsAdd4.Name = "COLLECTIONS ALL"
Set wsAdd5 = Sheets.Add(After:=Sheets(Worksheets.Count))
wsAdd5.Name = "TRANSFER DELS"
Set wsAdd6 = Sheets.Add(After:=Sheets(Worksheets.Count))
wsAdd6.Name = "TRANSFER COLS"
ApXL.ActiveWorkbook.SaveAs strPathName & FileName
ApXL.Workbooks.Open strPathName & FileName, True, False
ApXL.Visible = True
With xlWB
.Worksheets(1).Cells(2, 1) = ""
.Worksheets(1).Cells(3, 1) = ""
.Worksheets(1).Cells(1, 3) = "QTY"
.Worksheets(1).Cells(1, 4) = "PRODUCT TYPE"
.Worksheets(1).Cells(1, 5) = "PRODUCTNUMBER"
.Worksheets(1).Cells(1, 6) = "PO-NUMBER"
.Worksheets(1).Cells(1, 7) = "UPHOLSTRY"
.Worksheets(1).Cells(1, 8) = "DMT SORT NO"
'.Worksheets(1).Range("K3:K" & rs.RecordCount) = "Yes"
.Worksheets(1).Cells(3, 3).CopyFromRecordset rs
.Worksheets(1).Range("C3:H3").Borders(xlEdgeTop).LineStyle = xlContinuous
.Worksheets(1).Cells.EntireColumn.AutoFit
.Worksheets(1).Cells.EntireColumn.HorizontalAlignment = xlLeft
'.Worksheets(1).Columns("C:C").NumberFormat = "dd-mmm-yy"
.Worksheets(2).Cells(1, 3) = "DEL TO"
.Worksheets(2).Cells(1, 4) = "TOWN"
.Worksheets(2).Cells(1, 5) = "SL-NUMBER"
.Worksheets(2).Cells(1, 6) = "PO-NUMBER"
.Worksheets(2).Cells(1, 7) = "PRODUCT TYPE"
.Worksheets(2).Cells(1, 8) = "PRODUCT NUMBER"
.Worksheets(2).Cells(1, 9) = "CURRENT STATUS"
.Worksheets(2).Cells(3, 3).CopyFromRecordset rs2
.Worksheets(2).Range("C3:I3").Borders(xlEdgeTop).LineStyle = xlContinuous
.Worksheets(2).Cells.EntireColumn.AutoFit
.Worksheets(2).Cells.EntireColumn.HorizontalAlignment = xlLeft
'.Worksheets(2).Columns("C:C").NumberFormat = "dd-mmm-yy"
.Worksheets(3).Cells(1, 3) = "DELIVERY DATE"
.Worksheets(3).Cells(1, 4) = "DEL TO"
.Worksheets(3).Cells(1, 5) = "TOWN"
.Worksheets(3).Cells(1, 6) = "SL-NUMBER"
.Worksheets(3).Cells(1, 7) = "PO-NUMBER"
.Worksheets(3).Cells(1, 8) = "PRODUCT TYPE"
.Worksheets(3).Cells(1, 9) = "PRODUCT NUMBER"
.Worksheets(3).Cells(1, 10) = "CURRENT STATUS"
.Worksheets(3).Cells(3, 3).CopyFromRecordset rs3
.Worksheets(3).Range("C3:J3").Borders(xlEdgeTop).LineStyle = xlContinuous
.Worksheets(3).Cells.EntireColumn.AutoFit
.Worksheets(3).Cells.EntireColumn.HorizontalAlignment = xlLeft
.Worksheets(3).Columns("C:C").NumberFormat = "dd-mmm-yy"
.Worksheets(4).Cells(1, 3) = "COLLECTION DATE"
.Worksheets(4).Cells(1, 4) = "DEL TO"
.Worksheets(4).Cells(1, 5) = "TOWN"
.Worksheets(4).Cells(1, 6) = "SL-NUMBER"
.Worksheets(4).Cells(1, 7) = "PO-NUMBER"
.Worksheets(4).Cells(1, 8) = "PRODUCT TYPE"
.Worksheets(4).Cells(1, 9) = "PRODUCT NUMBER"
.Worksheets(4).Cells(1, 10) = "CURRENT STATUS"
.Worksheets(4).Cells(3, 3).CopyFromRecordset rs4
.Worksheets(4).Range("C3:J3").Borders(xlEdgeTop).LineStyle = xlContinuous
.Worksheets(4).Cells.EntireColumn.AutoFit
.Worksheets(4).Cells.EntireColumn.HorizontalAlignment = xlLeft
.Worksheets(4).Columns("C:C").NumberFormat = "dd-mmm-yy"
.Worksheets(5).Cells(1, 3) = "ADDED"
.Worksheets(5).Cells(1, 4) = "DEL TO"
.Worksheets(5).Cells(1, 5) = "TOWN"
.Worksheets(5).Cells(1, 6) = "SL-NUMBER"
.Worksheets(5).Cells(1, 7) = "PO-NUMBER"
.Worksheets(5).Cells(1, 8) = "PRODUCT TYPE"
.Worksheets(5).Cells(1, 9) = "PRODUCT NUMBER"
.Worksheets(5).Cells(1, 10) = "CURRENT STATUS"
.Worksheets(5).Cells(3, 3).CopyFromRecordset rs5
.Worksheets(5).Range("C3:J3").Borders(xlEdgeTop).LineStyle = xlContinuous
.Worksheets(5).Cells.EntireColumn.AutoFit
.Worksheets(5).Cells.EntireColumn.HorizontalAlignment = xlLeft
.Worksheets(5).Columns("C:C").NumberFormat = "dd-mmm-yy"
.Worksheets(6).Cells(1, 3) = "DELIVERY DATE"
.Worksheets(6).Cells(1, 4) = "DEL TO"
.Worksheets(6).Cells(1, 5) = "TOWN"
.Worksheets(6).Cells(1, 6) = "SL-NUMBER"
.Worksheets(6).Cells(1, 7) = "PO-NUMBER"
.Worksheets(6).Cells(1, 8) = "PRODUCT TYPE"
.Worksheets(6).Cells(1, 9) = "PRODUCT NUMBER"
.Worksheets(6).Cells(1, 10) = "CURRENT STATUS"
.Worksheets(6).Cells(3, 3).CopyFromRecordset rs6
.Worksheets(6).Range("C3:J3").Borders(xlEdgeTop).LineStyle = xlContinuous
.Worksheets(6).Cells.EntireColumn.AutoFit
.Worksheets(6).Cells.EntireColumn.HorizontalAlignment = xlLeft
.Worksheets(6).Columns("C:C").NumberFormat = "dd-mmm-yy"
.Worksheets(7).Cells(1, 3) = "COLLECTION DATE"
.Worksheets(7).Cells(1, 4) = "DEL TO"
.Worksheets(7).Cells(1, 5) = "TOWN"
.Worksheets(7).Cells(1, 6) = "SL-NUMBER"
.Worksheets(7).Cells(1, 7) = "PO-NUMBER"
.Worksheets(7).Cells(1, 8) = "PRODUCT TYPE"
.Worksheets(7).Cells(1, 9) = "PRODUCT NUMBER"
.Worksheets(7).Cells(1, 10) = "CURRENT STATUS"
.Worksheets(7).Cells(3, 3).CopyFromRecordset rs7
.Worksheets(7).Range("C3:J3").Borders(xlEdgeTop).LineStyle = xlContinuous
.Worksheets(7).Cells.EntireColumn.AutoFit
.Worksheets(7).Cells.EntireColumn.HorizontalAlignment = xlLeft
.Worksheets(7).Columns("C:C").NumberFormat = "dd-mmm-yy"
.Worksheets(8).Cells(1, 3) = "MANUF NO"
.Worksheets(8).Cells(1, 4) = "SL-NUMBER"
.Worksheets(8).Cells(1, 5) = "PARTNER"
.Worksheets(8).Cells(1, 6) = "PRODUCT TYPE"
.Worksheets(8).Cells(1, 7) = "PO-NUMBER"
.Worksheets(8).Cells(1, 8) = "SHIPPED"
.Worksheets(8).Cells(1, 9) = "DELIVERY DATE"
.Worksheets(8).Cells(1, 10) = "ON LINE XL ROW NO"
.Worksheets(8).Cells(6, 3).CopyFromRecordset rs8
.Worksheets(8).Columns("I:I").NumberFormat = "dd-mmm-yy"
.Worksheets(8).Range("C3:J3").Borders(xlEdgeTop).LineStyle = xlContinuous
.Worksheets(8).Cells.EntireColumn.AutoFit
.Worksheets(8).Cells.EntireColumn.HorizontalAlignment = xlLeft
.Worksheets(9).Cells(1, 3) = "MANUF NO"
.Worksheets(9).Cells(1, 4) = "SL-NUMBER"
.Worksheets(9).Cells(1, 5) = "PARTNER"
.Worksheets(9).Cells(1, 6) = "PRODUCT TYPE"
.Worksheets(9).Cells(1, 7) = "PO-NUMBER"
.Worksheets(9).Cells(1, 8) = "SHIPPED"
.Worksheets(9).Cells(1, 9) = "COLLECTION DATE"
.Worksheets(9).Cells(1, 10) = "ON LINE XL ROW NO"
.Worksheets(9).Cells(6, 3).CopyFromRecordset rs9
.Worksheets(9).Range("C3:J3").Borders(xlEdgeTop).LineStyle = xlContinuous
.Worksheets(9).Cells.EntireColumn.AutoFit
.Worksheets(9).Cells.EntireColumn.HorizontalAlignment = xlLeft
.Worksheets(9).Columns("I:I").NumberFormat = "dd-mmm-yy"
.Save
xlWB.Close
ApXL.Quit
Set ApXL = Nothing
End With