[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. :)
Re: Export To Excel into Wkshts by mnth and yr
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.
Re: Export To Excel into Wkshts by mnth and yr
so just 3 tabs in that case?
2005, 2006, 2007???
Re: Export To Excel into Wkshts by mnth and yr
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.
Re: Export To Excel into Wkshts by mnth and yr
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
Re: Export To Excel into Wkshts by mnth and yr
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.
Re: Export To Excel into Wkshts by mnth and yr
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
Re: Export To Excel into Wkshts by mnth and yr
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]
Re: Export To Excel into Wkshts by mnth and yr
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
Re: Export To Excel into Wkshts by mnth and yr
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
Re: Export To Excel into Wkshts by mnth and yr
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?
Re: Export To Excel into Wkshts by mnth and yr
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
Re: Export To Excel into Wkshts by mnth and yr
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
Re: Export To Excel into Wkshts by mnth and yr
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
Re: Export To Excel into Wkshts by mnth and yr
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 :)
Re: Export To Excel into Wkshts by mnth and yr
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
;)
Re: [RESOLVED] Export To Excel into Wkshts by mnth and yr
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.
Re: [RESOLVED] Export To Excel into Wkshts by mnth and yr
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: