Create Excel from Access (1 Viewer)

[zfar]

Ok after reading all of this seems like I am not going to go that route. Switching if I get approved I want to try to create a monthly spreadsheet that shows days off in the same format as the yearly one. How do you format an excel spreadsheet through VBA in access?

I like the methods outlined by Access Jitsu in this series of Youtube videos.
Maybe it will help you.

Incidentally, the transfer spreadsheet methods seem to have stopped working in the later access updates and I have reverted to simple exports and then formatting in Excel later.

 

[Darrell]

For what it's worth, here is a rough attempt at what you originally were looking for where the spreadsheet is updated after the Save button is clicked.

I've based this on the following:
- The Input form in access has: Staff ID (ie a unique number), First Name, Last Name, Leave Type, Leave Date
- The first three columns in the excel sheets are: First Name, Last Name, Staff ID
- The sheet tabs are numbered and formatted as you have shown
- Reference for MS Excel Object Library is selected in access

Private Sub Save_Leave_Click()
On Error GoTo ErrorHandler

Dim MyFile As String
Dim appExcel As Object
Dim MyBook As Object
Dim MySheet As Object

Dim sID As String
Dim sFName As String
Dim sLName As String
Dim sLeave_Type As String
Dim dLeave_Date As Date
Dim sYear_St As String

sID = Me.Personnel_ID
sFName = Me.First_Name
sLName = Me.Last_Name
sLeave_Type = Me.Leave_Type
dLeave_Date = Me.Leave_Date
dYear_St = CDate("01/01/" & Year(dLeave_Date))

MyFile = "H:\Leave Register.xlsx"   ' Data file to update

' Open the data file
Set appExcel = GetObject(, "Excel.Application")
Set MyBook = appExcel.workbooks.Open(MyFile)

' Modify the data file
With appExcel
    Dim iLastRow As Integer
    Dim i As Integer
    Dim iRow As Integer
    Dim iCol As Integer
    Dim rRange As Range

    .ScreenUpdating = False
   
    ' Find the correct sheet
    For i = 1 To MyBook.sheets.Count
        If Right(MyBook.sheets(i).Name, 2) = Right(dLeave_Date, 2) Then
            Set MySheet = MyBook.sheets(i)
            Exit For
        End If
    Next i
   
    ' Check if sheet is Leap Year
    If .Range("BK3") = 1 Then       'Not a leap year
        iCol = dLeave_Date - dYear_St + 4
    Else
        iCol = dLeave_Date - dYear_St + 5
    End If
   
    ' Find the staff and update date cell
    With MySheet
        .Activate
        iLastRow = .Range("A65536").End(xlUp).Row
       
        Set rRange = .Cells.Find(what:=sID, After:=.Range("A1"), LookIn:=xlFormulas, LookAt _
            :=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
       
        If rRange Is Nothing Then
            iRow = iLastRow + 1
            .Range("A" & iRow) = sFName
            .Range("B" & iRow) = sLName
            .Range("C" & iRow) = sID
        Else
            iRow = rRange.Row
        End If
        .Cells(iRow, iCol) = "OFF"
    End With
    MyBook.Close True
End With

MsgBox "Excel sheet updated.", vbInformation + vbOKOnly, "Leave Form Update"

Exit_Sub:
    appExcel.ScreenUpdating = True
    Set appExcel = Nothing
    Set rRange = Nothing
    Set MyBook = Nothing
    Set MySheet = Nothing
    Exit Sub

ErrorHandler:
    If Err = 429 Then   ' Excel is not running; open Excel with CreateObject
        Set appExcel = CreateObject("Excel.Application")
        appExcel.Visible = True
        Resume Next
    Else
       MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description
       Resume Exit_Sub
    End If

End Sub

So this works for me, it might help get you started at least.

 

[Valentine]

Darell, that is pretty awesome, thank you. I have kinda defaulted back to the original ask as well and created the shell of my spreadsheet. I also have a query that pulls all leave input into the database with the last and first name. I want to now pull that query and put it into the spreadsheet

I think I am going to add in ID# before rank so I can confirm I am getting the right person.

SELECT Roster.[DoD ID], Roster.Rank, Roster.[Last Name], Roster.[First Name], Leave.[Start Date], Leave.[End Date]
FROM Roster LEFT JOIN Leave ON Roster.[DoD ID] = Leave.[DoD ID]
WHERE (((Roster.[Last Name]) Not Like "AAA*"))
ORDER BY Roster.[Last Name];

That is the query I created for this spreadsheet.

 

[Valentine]

I took a stab at it but can't get my for statement to work properly.

    Dim rsRoster As DAO.Recordset
    Dim dbCurr As DAO.Database
    Dim xlApp As Object
    Dim xlWB As Object
    Dim xlSh As Object
    Dim strRoster As String
    Dim vCel As Variant
    
    Set xlApp = CreateObject("Excel.Application")
    Set xlWB = xlApp.Workbooks.Add
    Set xlSh = xlWB.ActiveSheet
    xlApp.Visible = True
    
    Set dbCurr = CurrentDb()
    strRoster = "SELECT Roster.[DoD ID], Roster.[Last Name], Roster.[First Name] " _
              & "FROM Roster " _
              & "WHERE Roster.[DoD ID] Not Like 'AAA*' " _
              & "Order By Roster.[Last Name];"
    Set rsRoster = dbCurr.OpenRecordset(strRoster)
    For Each vCel In xlWB
        With vCel
            .Activate
            .Cells(4, 1).CopyFromRecordset rsRoster
        End With
    Next
    rsRoster.Close
    set rsRoster = Nothing

 

[Gasman]

Again, I think you should be using xlsh?
Vcell should be a range?
You are hardcoding cells(4,1) regardless of cell?
I do not know how many times I have to say it
WALK THROUGH YOUR CODE!

 

[Darrell]

I have kinda defaulted back to the original

OK looks you have decided to create the Workbook from scratch when the report is run. You will probably need to work out how many sheets to create based on the range of leave in your table, but I'm sure you can work that out.

Gasman is right in that you are referencing the wrong object, this bit here should probably be:

With xlApp
    For Each xlSh In xlWB.Sheets
        xlSh.Cells(4, 1).CopyFromRecordset rsRoster
        rsRoster.MoveFirst
    Next xlSh
End With

 

[Gasman]

Gasman is right in that you are referencing the wrong object, this bit here should probably be:

With xlApp
    For Each xlSh In xlWB.Sheets
        xlSh.Cells(4, 1).CopyFromRecordset rsRoster
        rsRoster.MoveFirst
    Next xlSh
End With

Well TBH actually I thought the O/P was trying to move between cells on one sheet?
However I am now puzzled at the need to copy the same recordset to multiple sheets?

 

[Valentine]

It is just 1 sheet that encompasses the whole fiscal year. cell 4,1 is the start point that i want the roster query to input into the spreadsheet. There are over 100 soldiers so I want the query I created that has the soldiers names and DoD ID input into the spreadsheet starting at cell 4,1

 

[Gasman]

It is just 1 sheet that encompasses the whole fiscal year. cell 4,1 is the start point that i want the roster query to input into the spreadsheet. There are over 100 soldiers so I want the query I created that has the soldiers names and DoD ID input into the spreadsheet starting at cell 4,1

So no need for a loop?
Just select the sheet and copy the recordset.

 

[Valentine]

Yeah I just needed the 1 line to put the recordset into the spreadsheet.

xlSh.Cells(4, 1).CopyFromRecordset rsRoster

that worked perfectly.

My next issue is shading the weekends, I searched and found ability to shade a cell based on whats in the cell, but I want to shade the whole column based on whats in the cell.

    With xlSh.Range("D3", "ND3")
        If .Cells = "Saturday" Then
            .Columns.ColorIndex = 16
        End If
    End With

this is giving me a type mismatch at the if.cells line.

 

[arnelgp]

Dim rng As Range
For Each rng In xlSh.Range("d3:nd3")
    With rng
        If rng.Value2 = "Saturday" Then
            xlSh.Columns(.Column).Interior.ColorIndex = 16
        End If
    End With
Next

 

[Gasman]

I use .value in excel

 

[Valentine]

Dim rng as Range doesn't work in access. I kept seeing that in all my googles but couldn't get it to work in my database. I keep getting the error "User-Defined type not defined"

 

[arnelgp]

Dim rng As Object

 

[Darrell]

Well TBH actually I thought the O/P was trying to move between cells on one sheet?
However I am now puzzled at the need to copy the same recordset to multiple sheets?

Yeah I thought it was an odd way of doing it but his original request was to populate multiple sheets (1 sheet per year) and so I thought he was still going down that route. This request is a bit of a moving target to be fair...

 

[Pat Hartman]

Start by creating a crosstab that creates a rolling year of data so if you create the spreadsheet in May, it should be for June this year to May next year.

Use TransferSpreadsheet to export the data with no headers. Name the spreadsheet Leave_2022JuneThrough2023May. After you create the spreadsheet, open it and insert two rows of headers that you calculate based on the range.
Then loop through the day header row and using the Weekday() function, highlight the weekend days.

Issue a replacement at the end of each month so it is as fresh as possible.

 

[strive4peace]

I took a stab at it but can't get my for statement to work properly.

I realize you've gone past this, but FYI

 Dim vCel As Variant  'this should be Range or Object

   '...

    For Each vCel In xlWB 

        With vCel 

            .Activate 

            .Cells(4,1).CopyFromRecordset rsRoster 

        End With

 

[strive4peace]

Dim rng as Range doesn't work in access. I kept seeing that in all my googles but couldn't get it to work in my database. I keep getting the error "User-Defined type not defined"

@Valentine, When you're writing code to automate Excel, it's good to use early binding to develop. That means you reference (Tools, References...)
Microsoft Excel #.# Object Library
and dimension objects specifically

Dim appExcel As Excel.Application
Dim MyBook As Excel.Workbook
Dim MySheet As Excel.Worksheet
Dim MyCell As Excel.Range 

Then you have the BIG advantage of Intellisense!

after it's created and working how you want, if you plan to share with others, its a good idea to switch to late binding:

• dimension Excel objects as object
• change constants to their values
• remove reference to Excel
• compile

Dim appExcel As Object ' Excel.Application
Dim MyBook As Object ' Excel.Workbook
Dim MySheet As Object ' Excel.Worksheet
Dim MyCell As Object  ' Excel.Range   

MyCell.HorizontalAlignment = -4108   'xlCenter

 

[Valentine]

Thank you all for the help along the way, now I am at the part where I have no clue where to even start to make work. I need to loop through the recordset of all the leaves and put them acurately into the spreadsheet.

    strLeave = "SELECT Roster.[DoD ID], Leave.[Start Date], Leave.[End Date] " _
             & "FROM Roster INNER JOIN Leave ON Roster.[DoD ID] = Leave.[DoD ID] " _
             & "WHERE (((Roster.Status) Not Like 'Archive'));"
    Set rsLeave = dbCurr.OpenRecordset(strLeave)
    Do While rsLeave.EOF = False
        
        

    Loop

I created an rs filled with all the leave in the database. I need it to loop through and for each DoD ID it selects that row, then for each start date it has to select that column. I don't know how to do either of these. The spreadsheet doesn't have specific dates in columns I have it split out by month in row 1 and by days of month in row 2.

the date format in the fields in access are mm/dd/yyyy

 

[strive4peace]

hi @Valentine

Sorry for your frustration. Perhaps studying this example will help you

Export records from a Query, by whatever grouping you want, to Excel on different sheets in same file, or different files
http://msaccessgurus.com/VBA/Code/aExcel_ExportQueryGroups.htm

An Excel spreadsheet is simply a big 2-dimensional array.

oWorksheet.cells(1,1) means A1
oWorksheet.cells(3,1) means A3 not C1 since the array is referenced by row,column instead of column/row as standard references are

so if you can calculate, numerically, what row and column the data needs to be in, it's easy to put it there