[RESOLVED] Export To Excel into Wkshts by mnth and yr

Hello all.

I'm brand new to this forum, so I hope I'm posting this in the right section.

I've established code that will export data to excel into a workbook with
tabs(worksheets) for each month(based on a field expdate). What I'd like to
do is make tabs not only based on month, but on year as well, for the
following reason:

Basically, each group of customers is generally in a 12 month time-frame;
however, there are some exceptions to the rule that extend into the previous
year and the upcoming year. So, my ideal set-up would be to probably create
worksheets with outer limits that only extend to months that contain records.
So, if there was a policy that had an exp date of 12/24/05 and the rest were
in '06, the output would only create a dec 2005 and not a nov2005 or any
other 2005 because they didn't contain records. Hope this kind of helps w the
explanation.

Here is the code I've been working with (I didn't set it all up, much is
taken from online examples, but the field names are mine and part of my test
database)

VB Code:

Sub CreateXL()
Dim strSQL As String
Dim qdf As Object
Dim strFilename As String
Dim I As Long
Dim Yr As Long
Dim YearFirst As Long
Dim YearLast As Long
Dim resp
 
   strFilename = "C:\" & [Forms]![Form]![TC] & ".xls"
   
   If Dir(strFilename) <> "" Then
       resp = MsgBox("This group's import already exists." & vbCrLf & "Do
you wish to replace it?", vbYesNo)
       If resp = vbYes Then
           Kill strFilename
       Else
           Exit Sub
       End If
   End If
   
   YearFirst = DMin("Year(ExpDate)", "Table1")
   YearLast = DMax("Year(ExpDate)", "Table1")
   For Yr = YearFirst To YearLast
       If DCount("Year(Expdate)", "Table1", "Year(Expdate)=" & Yr) > 0 Then
       
           For I = 1 To 12
               If DCount("Month(Expdate)", "Table1", "Month(Expdate)=" & I)
 
> 0 Then
                   strSQL = "SELECT  Table1.Customer, Table1.ZipCode, Table1.
ItemType, Table1.ExpDate "
                   strSQL = strSQL & "FROM Table2 INNER JOIN Table1 ON
Table2.GroupCode = Table1.GroupCode "
                   strSQL = strSQL & "WHERE Table1.GroupCode='" & [Forms]!
[Form]![TC] & "' AND Month(Table1.Expdate)= " & I & " AND Year(Table1.Expdate)
= " & Yr
                   strSQL = strSQL & " ORDER BY Table1.Customer"
                   Set qdf = CurrentDb.CreateQueryDef(Format(DateSerial(2006,
I, 1), "mmm") & Yr, strSQL)
                   DoCmd.TransferSpreadsheet acExport,
acSpreadsheetTypeExcel9, qdf.Name, strFilename
                   CurrentDb.QueryDefs.Delete qdf.Name
               End If
           Next I
           
       End If
   Next Yr
   FormatWB strFilename
End Sub
Sub FormatWB(strFilename As String)
Dim xlApp As Object
Dim xlWB As Object
Dim xlWS As Object
   Set xlApp = CreateObject("Excel.Application")
   Set xlWB = xlApp.Workbooks.Open(strFilename)
   For Each xlWS In xlWB.Worksheets
       xlWS.Range("A1:L1").Font.Bold = True
       xlWS.Range("A:L").Columns.AutoFit
       xlWS.Range("1:1").Insert
       With xlWS.Range("A1")
           .Value = [Forms]![Form]![TC]
           .Font.Size = 24
           .Font.Bold = True
       End With
   Next xlWS
   xlWB.Close True
   DoCmd.Close ' Close Form
End Sub

Thanks for any and all help. Right now I can't really tell what range of months my
code is taking, but my goal was to only have wksht tabs that extend to the
outter limits of the exp date field.

If anyone would like me to attach my sample db let me know. It would be a lifesaver if someone could sort through all this. :)

ok..
first: http://www.vbforums.com/

second: yes.. this is the correct forum http://www.vbforums.com/

third: your code...

its hard to tell.. but it seems like you are exporting spread sheets.. 1 per month per year??

I would do it this way:

start excel.. add a workbook... delete 2 sheets (so you only have 1)

the in you loop.. add a sheet.. fill it out.. name it month_year
next loop add again.. etc..

use activesheet.copyfromrecordset

if you attach your test DB then i can play with it a bit

you need to either zip the DB or just change the extention to txt to post it.

Hello.

Thanks for the Welcome. I'm going to post a sample DB that has my basic setup and the code for export behind a form called 'form'. I'd like to keep everything automated in Access because each export will have to be mailed out to someone and I'd like to not have to open Excel.

Generally the period for a group is 12 months ( for this case it would be 2006). But, some records fall just outside of that year.

I guess my goal would be to not have to create 36 tabs for this scenario because there are technically records with 3 different years. I'd like for all months to show for the principle year 2006, and only those with records show for 2005 and 2007

Thanks again for the help!

so just 3 tabs in that case?
2005, 2006, 2007???

No not exactly. What I'd like is tabs as follows: dec 2005, jan 2006 feb 2006 mar 2006 april 2006...etc, jan 2007 only.

So, Ideally, month and year as tab labels, but only including those months in 2005 and 2007 that have records.

TO make Excel not visible then comment out the visible = true line
make sure you save the workbook in code when done...

VB Code:

Sub CreateXL()
Dim strSQL As String
Dim qdf As Object
Dim strFilename As String
Dim I As Long
Dim Yr As Long
Dim YearFirst As Long
Dim YearLast As Long
Dim resp
 
    strFilename = "C:\Documents and Settings\Desktop\Excel Exports\" & [Forms]![Form]![TC] & ".xls"
    
    If Dir(strFilename) <> "" Then
        resp = MsgBox("This group's import already exists." & vbCrLf & "Do you wish to replace it?", vbYesNo)
        If resp = vbYes Then
            Kill strFilename
        Else
            Exit Sub
        End If
    End If
    Dim xlApp As Object
    Dim xlWB As Object
    Dim xlWS As Object
        Set xlApp = CreateObject("Excel.Application")
        xlApp.Visible = True
        Set xlWB = xlApp.workbooks.Add()
        xlWB.Sheets(2).Delete
        xlWB.Sheets(2).Delete
    
    Dim rs As New Recordset
    Dim cnn As Connection
    Set cnn = Application.CurrentProject.Connection
    YearFirst = DMin("Year(ExpDate)", "Table1")
    YearLast = DMax("Year(ExpDate)", "Table1")
    For Yr = YearFirst To YearLast
        If DCount("Year(Expdate)", "Table1", "Year(Expdate)=" & Yr) > 0 Then
            For I = 1 To 12
                
                
                If DCount("Month(Expdate)", "Table1", "Month(Expdate)=" & I) > 0 Then
                    strSQL = "SELECT  Table1.Customer, Table1.ZipCode, Table1.ItemType, Table1.ExpDate "
                    strSQL = strSQL & "FROM Table2 INNER JOIN Table1 ON Table2.GroupCode = Table1.GroupCode "
                    strSQL = strSQL & "WHERE Table1.GroupCode='" & [Forms]![Form]![TC] & "' AND Month(Table1.Expdate)= " & I & " AND Year(Table1.Expdate) = " & Yr
                    strSQL = strSQL & " ORDER BY Table1.Customer"
                   
                    rs.Open strSQL, cnn, adOpenDynamic, adLockOptimistic
                    If (Yr <> Year(Date) And rs.EOF <> True) Or Yr = Year(Date) Then
                       Set xlWS = xlWB.Sheets.Add(, xlWB.Sheets(xlWB.Sheets.Count))
                       xlWS.Name = Format(CDate(I & "/01/" & Yr), "mmm YYYY")
                       xlWS.range("A2").copyfromrecordset rs
                      
                    End If
                    rs.Close
                End If
            Next I
         End If
    Next Yr
    'FormatWB strFilename
End Sub

This is great!! it appears to work perfectly...

just a few questions...i'm very new to code i was wondering if you could show me how to save the workbook with code.

Also, I have some formatting of the output that I was doing in my code above with the procedure Sub FormatWB(strFilename As String). Could I just call that procedure at the end of the code?

Thanks again for the prompt responses. This will be a lifesaver.

Also, could you explain how its creating the tabs it is? Is it defaulting that it should create 12 tabs for 2006? Thank you again.

well i cut a few corners.. :D cant give you the WHOLE pie now can i?

I did delete 2 sheets.. so the Workbook starts with one..
I never removed the leftover Sheet1...(u should be able to figure that one out..tip.. you cannot delete that sheet if its the only sheet.. so do it at the end)

well you could call the format sub.. BUT you are opening the file etc.. instead.. pass in the whole workbook object

VB Code:

Sub FormatWB(xlWB As Object)
Dim xlWS As Object
   Set xlWB = xlApp.Workbooks.Open(strFilename)

so call it like this from the other sub

FormatWB xlWB
(in the same place you were doing it)

Dont Close the Wkbook from the Format Sub (or the form)

after you call the formatWB

xlWB.SaveAs "c:\Path\To\Filename.xls"
xlWB.Close

then be sure to
Set xlWS = Nothing
Set xlWB = Nothing
xlAPP.Quit
Set xlApp = Nothing

I forgot to explain.... :D sorry

alright..
these lines create the sheet and name it
Set xlWS = xlWB.Sheets.Add(, xlWB.Sheets(xlWB.Sheets.Count))
xlWS.Name = Format(CDate(I & "/01/" & Yr), "mmm YYYY")

it will ALWAYS create 12 month tabs for the Current Year
and Only a tab for each month of prev/next year that has data...
this is done in the IF statement

If (Yr <> Year(Date) And rs.EOF <> True) Or Yr = Year(Date) Then

if the Yr (Yr from loop) is Not = Year(Date) Current Year AND the Rs.EOF (EndOfFile) is Not true .. meaning it has records.. then allow it to create the sheet
OR
If the Yr is the Current Year (Year(Date)) then allow it

how I explained that well enough

Here is the BEST TIP you will get concerning working with excel
in excel.. record a macro of what you are trying to do... then look at the macro code

theres your code! (youwill need to tweak some things... but thats basically it)

also.. you can add a refernce to the MS Excel x.0 Object Library in access.. then programming for excel is easier.. you will get the intellisense dropdowns
Dim xls As Excel.Application
xls.[DROPDOWN]

Thanks for the explanation Static...you've been of great help.

I'm stumbling a bit though putting this code in action...let me show you what I currently have and see what you think.

Its giving me an error where i call the formatWB x1WB saying byRef ArgType Mismatch.

VB Code:

Option Compare Database
Private Sub Command1_Click()
CreateXL
End Sub
Sub CreateXL()
Dim strSQL As String
Dim qdf As Object
Dim strFilename As String
Dim I As Long
Dim Yr As Long
Dim YearFirst As Long
Dim YearLast As Long
Dim resp
 
    strFilename = "C:\Documents and Settings\Desktop\Excel Exports\" & [Forms]![Form]![TC] & ".xls"
    
    If Dir(strFilename) <> "" Then
        resp = MsgBox("This group's import already exists." & vbCrLf & "Do you wish to replace it?", vbYesNo)
        If resp = vbYes Then
            Kill strFilename
        Else
            Exit Sub
        End If
    End If
    Dim xlApp As Object
    Dim xlWB As Object
    Dim xlWS As Object
        Set xlApp = CreateObject("Excel.Application")
        xlApp.Visible = True
        Set xlWB = xlApp.Workbooks.Add()
        xlWB.Sheets(2).Delete
        xlWB.Sheets(2).Delete
    
    Dim rs As New Recordset
    Dim cnn As Connection
    Set cnn = Application.CurrentProject.Connection
    YearFirst = DMin("Year(ExpDate)", "Table1")
    YearLast = DMax("Year(ExpDate)", "Table1")
    For Yr = YearFirst To YearLast
        If DCount("Year(Expdate)", "Table1", "Year(Expdate)=" & Yr) > 0 Then
            For I = 1 To 12
                
                
                If DCount("Month(Expdate)", "Table1", "Month(Expdate)=" & I) > 0 Then
                    strSQL = "SELECT  Table1.Customer, Table1.ZipCode, Table1.ItemType, Table1.ExpDate "
                    strSQL = strSQL & "FROM Table2 INNER JOIN Table1 ON Table2.GroupCode = Table1.GroupCode "
                    strSQL = strSQL & "WHERE Table1.GroupCode='" & [Forms]![Form]![TC] & "' AND Month(Table1.Expdate)= " & I & " AND Year(Table1.Expdate) = " & Yr
                    strSQL = strSQL & " ORDER BY Table1.Customer"
                   
                    rs.Open strSQL, cnn, adOpenDynamic, adLockOptimistic
                    If (Yr <> Year(Date) And rs.EOF <> True) Or Yr = Year(Date) Then
                       Set xlWS = xlWB.Sheets.Add(, xlWB.Sheets(xlWB.Sheets.Count))
                       xlWS.Name = Format(CDate(I & "/01/" & Yr), "mmm YYYY")
                       xlWS.Range("A2").copyfromrecordset rs
                      
                    End If
                    rs.Close
                End If
            Next I
         End If
    Next Yr
    FormatWB x1WB
x1WB.SaveAs "c:\Documents and Settings\Desktop\Excel Exports\" & [Forms]![Form]![TC] & ".xls"
x1WB.Close
Set X1WS = Nothing
Set x1WB = Nothing
xlApp.Quit
Set xlApp = Nothing
End Sub
Sub FormatWB(x1WB As Object)
Dim xlWS As Object
Dim xlWB As Object
  Setx1WB = xlApp.Workbooks.Open(strFilename)
   For Each xlWS In xlWB.Worksheets
       xlWS.Range("A1:L1").Font.Bold = True
       xlWS.Range("A:L").Columns.AutoFit
       xlWS.Range("1:1").Insert
       With xlWS.Range("A1")
           .Value = [Forms]![Form]![TC]
           .Font.Size = 24
           .Font.Bold = True
       End With
   Next xlWS
End Sub

well it all looks good.. but look a little closer at your code...

x1WB

you have a 1 in there..

and:
remove the set xl and open commands...

VB Code:

Sub FormatWB(xlWB As Object)
Dim xlWS As Object
   For Each xlWS In xlWB.Worksheets
       xlWS.Range("A1:L1").Font.Bold = True
       xlWS.Range("A:L").Columns.AutoFit
       xlWS.Range("1:1").Insert
       With xlWS.Range("A1")
           .Value = [Forms]![Form]![TC]
           .Font.Size = 24
           .Font.Bold = True
       End With
   Next xlWS
End Sub

sorry to continue to pester...but when i change to FormatWB (xWB) as my call statement it runs the procedure (opening excel and doing everything that comes before it) and then comes up with an error that says Object required and brings me to that line in the code...any ideas?

no pester... here.. replace all your code with this:

then change the SaveAs Filename
and the reason for the error was that the 1 should have been an l (lower L)
:D

VB Code:

Option Compare Database
Private Sub Command1_Click()
CreateXL
End Sub
Sub CreateXL()
Dim strSQL As String
Dim qdf As Object
Dim strFilename As String
Dim I As Long
Dim Yr As Long
Dim YearFirst As Long
Dim YearLast As Long
Dim resp
 
    strFilename = "C:\Documents and Settings\Desktop\Excel Exports\" & [Forms]![Form]![TC] & ".xls"
    
    If Dir(strFilename) <> "" Then
        resp = MsgBox("This group's import already exists." & vbCrLf & "Do you wish to replace it?", vbYesNo)
        If resp = vbYes Then
            Kill strFilename
        Else
            Exit Sub
        End If
    End If
    Dim xlApp As Object
    Dim xlWB As Object
    Dim xlWS As Object
        Set xlApp = CreateObject("Excel.Application")
        xlApp.Visible = True
        Set xlWB = xlApp.workbooks.Add()
        xlWB.sheets(2).Delete
        xlWB.sheets(2).Delete
    
    Dim rs As New Recordset
    Dim cnn As Connection
    Set cnn = Application.CurrentProject.Connection
    YearFirst = DMin("Year(ExpDate)", "Table1")
    YearLast = DMax("Year(ExpDate)", "Table1")
    For Yr = YearFirst To YearLast
        If DCount("Year(Expdate)", "Table1", "Year(Expdate)=" & Yr) > 0 Then
            For I = 1 To 12
                
                
                If DCount("Month(Expdate)", "Table1", "Month(Expdate)=" & I) > 0 Then
                    strSQL = "SELECT  Table1.Customer, Table1.ZipCode, Table1.ItemType, Table1.ExpDate "
                    strSQL = strSQL & "FROM Table2 INNER JOIN Table1 ON Table2.GroupCode = Table1.GroupCode "
                    strSQL = strSQL & "WHERE Table1.GroupCode='" & [Forms]![Form]![TC] & "' AND Month(Table1.Expdate)= " & I & " AND Year(Table1.Expdate) = " & Yr
                    strSQL = strSQL & " ORDER BY Table1.Customer"
                   
                    rs.Open strSQL, cnn, adOpenDynamic, adLockOptimistic
                    If (Yr <> Year(Date) And rs.EOF <> True) Or Yr = Year(Date) Then
                       Set xlWS = xlWB.sheets.Add(, xlWB.sheets(xlWB.sheets.Count))
                       xlWS.Name = Format(CDate(I & "/01/" & Yr), "mmm YYYY")
                       xlWS.range("A2").copyfromrecordset rs
                      
                    End If
                    rs.Close
                End If
            Next I
         End If
    Next Yr
    xlWB.sheets("Sheet1").Delete
    FormatWB xlWB
    xlWB.sheets(1).Activate
    [B]xlWB.saveas "C:\temp.xls"[/B]
    Set xlWS = Nothing
    xlWB.Close
    Set xlWB = Nothing
    xlApp.Quit
    Set xlApp = Nothing
End Sub
 
Sub FormatWB(xlWB As Object)
Dim xlWS As Object
    For Each xlWS In xlWB.Worksheets
        xlWS.range("A1:L1").Font.Bold = True
        xlWS.range("A:L").Columns.AutoFit
        xlWS.range("1:1").Insert
        With xlWS.range("A1")
            .Value = [Forms]![Form]![TC]
            .Font.Size = 24
            .Font.Bold = True
        End With
    Next xlWS
End Sub

Static you've been outstanding help.

Just two more quick questions. I think with some of the code examples i had tried from other places online i managed to make my excel default to having 12 sheets (instead of just sheet1, sheet2, sheet3). How can I change this back?

Also, Id like the column headings to appear above the records. I thought I had that incorporated but its not churning them out.

Again, I'm amazed by this forums response time and accuracy.

Thanks again

ahh.. ok.

Options General - Sheets in new workbook...set it back to 3 :)

you had them incorporated.. BUT I forgot to put them back in.. when using CopyFromRecordset it does not output the field names...sooo
change this part...
(I highlight the changes)

VB Code:

If (Yr <> Year(Date) And rs.EOF <> True) Or Yr = Year(Date) Then
                        Set xlWS = xlWB.sheets.Add(, xlWB.sheets(xlWB.sheets.Count))
                        xlWS.Name = Format(CDate(I & "/01/" & Yr), "mmm YYYY")
                        [B]For z = 0 To rs.Fields.Count - 1
                            xlWS.Cells(2, z + 1) = rs.Fields(z).Name
                        Next[/B]
                        [B]xlWS.range("A3").copyfromrecordset rs[/B]
                      
                    End If

Excellent! just one final question. I notice it's not making a tab for june 2006 ( which i believe is because there are no records for it). Is there any way to create all 12 tabs even if theres no records for the current year?

Also, could you let me know how to make this thread resolved afterwards? (once again I'm new). I read I was supposed to do this when my questions are answered.

THANKS :)

yep your right...
remove the 2 higlighted lines: (or just comment them out)

VB Code:

For Yr = YearFirst To YearLast
        If DCount("Year(Expdate)", "Table1", "Year(Expdate)=" & Yr) > 0 Then
            For I = 1 To 12
                
                
                [B]If DCount("Month(Expdate)", "Table1", "Month(Expdate)=" & I) > 0 Then[/B]
                    strSQL = "SELECT  Table1.Customer, Table1.ZipCode, Table1.ItemType, Table1.ExpDate "
                    strSQL = strSQL & "FROM Table2 INNER JOIN Table1 ON Table2.GroupCode = Table1.GroupCode "
                    strSQL = strSQL & "WHERE Table1.GroupCode='" & [Forms]![Form]![TC] & "' AND Month(Table1.Expdate)= " & I & " AND Year(Table1.Expdate) = " & Yr
                    strSQL = strSQL & " ORDER BY Table1.Customer"
                   
                    rs.Open strSQL, cnn, adOpenDynamic, adLockOptimistic
                    If (Yr <> Year(Date) And rs.EOF <> True) Or Yr = Year(Date) Then
                       Set xlWS = xlWB.sheets.Add(, xlWB.sheets(xlWB.sheets.Count))
                       xlWS.Name = Format(CDate(I & "/01/" & Yr), "mmm YYYY")
                       xlWS.range("A2").copyfromrecordset rs
                      
                    End If
                    rs.Close
                [B]End If[/B]
            Next I
         End If
    Next Yr

and to mark the thread resolved... just above your first post in this thread...
click Thread Tools > Mark Thread Resolved

;)

Thanks again for all the help static...I'll let you know if I have any problems moving this coding over to my real database.

Sorry but I'm not 100% resolved. I spoke too soon. I have a field that is a currency that is not keeping its formatting when it comes over to excel (it's coming as a number instead of currency). Is there any way I can fix this? Thanks, I hope someone sees the new post even though it reads resolved.



I Think I found a quick and easy solution. I added this line to the format WB procedure.

xlWS.Range("E:G").NumberFormat = "$#,##0"

That makes those 3 columns currencies like I want them.

Thanks again static for the great help. :wave: