Results 1 to 12 of 12
  1. #1
    DMT Dave is offline VIP
    Windows 10 Access 2016
    Join Date
    May 2018
    Posts
    1,185

    Debug on worksheets

    Hi Guys, this is a bizarre one to me! i get this error upon generating an XL file, when i end the debug window, click the button again, it will generate the Excel file no problem but only put's 3 worksheets on so i don't save that then on 3rd click, it will generate and output the data, any ideas ?

    Debug 1
    Click image for larger version. 

Name:	Capture1.JPG 
Views:	47 
Size:	15.3 KB 
ID:	36971
    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)) debugs at 1st click
    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"

    Continues to generate with 3 worksheets

    Click again then adds all worksheets ????

    With regards

  2. #2
    CJ_London is online now VIP
    Windows 10 Access 2010 32bit
    Join Date
    Mar 2015
    Posts
    11,397
    help if you showed the whole code - would appear you have not dimmed your variables, opened your workbook etc - and please copy paste your code and use the code tags, makes it much easier to respond - responders can copy paste your code for illustration/testing.

    However suspect you need xlWB. in front of your Sheets

  3. #3
    ranman256's Avatar
    ranman256 is online now VIP
    Windows Vista Access 2010 32bit
    Join Date
    Apr 2014
    Location
    Kentucky
    Posts
    9,521
    Just use :
    Sheets.Add
    set wsAdd = activesheet


  4. #4
    accesstos's Avatar
    accesstos is offline Expert
    Windows XP Access 2007
    Join Date
    Dec 2018
    Location
    Greece
    Posts
    551
    Also, you can say:
    Code:
    With xlWB
        .Sheets("Sheet2").Name = "DELIVERIES PENDING"
        .Sheets("Sheet3").Name = "DELIVERIES"
        .Sheets.Add(, .Sheets(.Sheets.Count)).Name = "COLLECTIONS"
        .Sheets.Add(, .Sheets(.Sheets.Count)).Name = "ON HOLD"
        .Sheets.Add(, .Sheets(.Sheets.Count)).Name = "DELIVERIES ALL"
        ' and so on
    End With
    As you use the Excel object outside of its namespace, you can run its object model only via the explicitly declared Workbook variable (e.g. xlWB) as above.

  5. #5
    DMT Dave is offline VIP
    Windows 10 Access 2016
    Join Date
    May 2018
    Posts
    1,185
    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

  6. #6
    DMT Dave is offline VIP
    Windows 10 Access 2016
    Join Date
    May 2018
    Posts
    1,185
    Hi Guy,s just an after thought, I know i can set Excel to have a standard of a quantity of worksheets, i guess then vba doesn't need to add any ??

  7. #7
    accesstos's Avatar
    accesstos is offline Expert
    Windows XP Access 2007
    Join Date
    Dec 2018
    Location
    Greece
    Posts
    551
    Dear Dave,

    To make your life simple, create a workbook as you want (say DailyUpdateTemplate.xlsx), with all worksheets that you need, with the required headers and formats, and use it as template for the daily update workbooks.

    After that, you can use a code, without all these unnecessary variables and variants, to update this template file and save it as new workbook with a "daily" name, as you can see below:
    Code:
    Function DailyUpdateExcel() As String
        Dim oXL As Object
        Dim oWB As Object
        Dim rs As DAO.Recordset
        Dim strSheetName As String
    
        Set oXL = CreateObject("Excel.Application")
        Set oWB = oXL.Workbooks.Open("T:\My Folder\XL Files\Daily Update\DailyUpdateTemplate.xlsx")
    
        With oWB
            strSheetName = "HG STOCK"
            With .Worksheets(strSheetName)
                Set rs = CurrentDb.OpenRecordset("SELECT tblStock.StartQty, tblStock.ProductType, " _
                                                 & "tblStock.ProductNo, tblStock.PONumber, " _
                                                 & "tblStock.Upholstry, tblStock.SortNo " _
                                                 & "FROM tblStock ORDER BY SortNo;")
                .Cells(3, 3).CopyFromRecordset rs
            End With
    
            'Next worksheet
            strSheetName = "DELIVERIES PENDING"
            With .Worksheets(strSheetName)
                Set rs = 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;")
                .Cells(3, 3).CopyFromRecordset rs
            End With
            '
            '...and so on for the rest worksheets
            '
            '
            'At the end...
            .SaveAs "T:\My Folder\XL Files\Daily Update\Daily Update " _
                    & Format(Me.txtUpdate, "dd-mm-yy") & ".xlsx"
            DailyUpdateExcel = .Name
        End With
    ExitHere:
        On Error Resume Next
        oWB.Close
        Set oWB = Nothing
        Set oXL = Nothing
        rs.Close
        Set rs = Nothing
        Exit Function
    ErrHandler:
        MsgBox "Error (#" & Err & ")" & vbCrLf & Err.Description, vbExclamation, "Sheet " & strSheetName
        Resume ExitHere
    End Function
    To create a daily updated workbook, you can do it like that:
    Code:
    Sub TestDailyUpdate()
        Dim strFile As String
        
        strFile = DailyUpdateExcel()
        If Len(strFile) Then
            MsgBox "Workbook '" & strFile & "' succesful created.", vbInformation
        Else
            MsgBox "Daily update failed!", vbExclamation
        End If
    End Sub

  8. #8
    Join Date
    Apr 2017
    Posts
    1,673
    Can't understand the current trend to write info from Access into Excel!

    Create an Excel report file, which uses odbc query to read info from your Access DB (from back-end in case the database is splitted). Set the query to be refreshed when Excel report workbook is opened, and whoever open's it gets latest available data at moment of opening the workbook - without any coding.

    When the database is protected, you can use a datasource to connect the query with database - either saving password with datasource, or asking the user the password on connecting. But easier would be to keep all info which needs protection (database, reports, etc.) in network resource(s) with limited access. Who isn't allowed the access doesn't even see those files.

  9. #9
    DMT Dave is offline VIP
    Windows 10 Access 2016
    Join Date
    May 2018
    Posts
    1,185
    Thank you, i am going to try this tomorrow, Do i set the Dim strings for MyStatus and Dim For Dates etc in a module (public functions) then call the code from the command button (your code) above ?

  10. #10
    DMT Dave is offline VIP
    Windows 10 Access 2016
    Join Date
    May 2018
    Posts
    1,185
    Absolute star, it worked a treat this......

  11. #11
    DMT Dave is offline VIP
    Windows 10 Access 2016
    Join Date
    May 2018
    Posts
    1,185
    Off the back of this code that works perfect thank you, is it possible to count the excel rows and add a spare row (to underline or fill grey) after each porduct type, the amount of records of product type can vary but usually no more than 10 of each products, hpe this makes sense, the reason is to have a gap or fill (or Group) the products

    Code:
    Function DailyUpdateExcel() As String
        Dim oXL As Object
        Dim oWB As Object
        Dim rs As DAO.Recordset
        Dim strSheetName As String
    
        Set oXL = CreateObject("Excel.Application")
        Set oWB = oXL.Workbooks.Open("T:\My Folder\XL Files\Daily Update\DailyUpdateTemplate.xlsx")
    
        With oWB
            strSheetName = "HG STOCK"
            With .Worksheets(strSheetName)
                Set rs = CurrentDb.OpenRecordset("SELECT tblStock.StartQty, tblStock.ProductType, " _
                                                 & "tblStock.ProductNo, tblStock.PONumber, " _
                                                 & "tblStock.Upholstry, tblStock.SortNo " _
                                                 & "FROM tblStock ORDER BY SortNo;")
                .Cells(3, 3).CopyFromRecordset rs
            End With
    
            'Next worksheet
            strSheetName = "DELIVERIES PENDING"
            With .Worksheets(strSheetName)
                Set rs = 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;")
                .Cells(3, 3).CopyFromRecordset rs
            End With
            '
            '...and so on for the rest worksheets
            '
            '
            'At the end...
            .SaveAs "T:\My Folder\XL Files\Daily Update\Daily Update " _
                    & Format(Me.txtUpdate, "dd-mm-yy") & ".xlsx"
            DailyUpdateExcel = .Name
        End With
    ExitHere:
        On Error Resume Next
        oWB.Close
        Set oWB = Nothing
        Set oXL = Nothing
        rs.Close
        Set rs = Nothing
        Exit Function
    ErrHandler:
        MsgBox "Error (#" & Err & ")" & vbCrLf & Err.Description, vbExclamation, "Sheet " & strSheetName
        Resume ExitHere End Function

  12. #12
    ssanfu is offline Master of Nothing
    Windows 7 32bit Access 2010 32bit
    Join Date
    Sep 2010
    Location
    Anchorage, Alaska, USA
    Posts
    9,664
    Yes, it is possible. Easiest way to get the basics of the code is to record a macro in Excel, then modify the to code to work in Access. You could put the code in a sub - then you would be able to call the sub to work in different sheets.

    Code:
        .
        .
        .
        With oWB
            strSheetName = "HG STOCK"
            With .Worksheets(strSheetName)
                Set rs = CurrentDb.OpenRecordset("SELECT tblStock.StartQty, tblStock.ProductType, " _
                                                 & "tblStock.ProductNo, tblStock.PONumber, " _
                                                 & "tblStock.Upholstry, tblStock.SortNo " _
                                                 & "FROM tblStock ORDER BY SortNo;")
                .Cells(3, 3).CopyFromRecordset rs
                Call InsertLines       '<<<<<------ Call to add line between products
            End With
            .
            .
            .
    The code would have to step through each row in the sheet and compare the previous cell to the current cell. If different, insert a line and shade it if you want.

Please reply to this thread with any new information or opinions.

Similar Threads

  1. Making use of Debug
    By GraeagleBill in forum Programming
    Replies: 5
    Last Post: 05-04-2018, 04:20 PM
  2. Debug warning
    By Jaap in forum Access
    Replies: 5
    Last Post: 10-13-2017, 01:24 PM
  3. Help Debug code
    By joym in forum Access
    Replies: 6
    Last Post: 05-24-2017, 04:15 PM
  4. Can't debug a Sub
    By wardw in forum Programming
    Replies: 6
    Last Post: 10-18-2013, 10:03 AM
  5. Debug
    By gio25 in forum Programming
    Replies: 1
    Last Post: 02-08-2011, 08:30 AM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  
Other Forums: Microsoft Office Forums