Export To Excel - Multiple Tabs (1 Viewer)

[acarterczyz]

Hey all,

I have a main form with two subforms. I'm trying to get my code so that it allows me to put 1 subform on one tab and the other spreadsheet on the other tab.

Heres my code:

Option Compare Database


Public Function Send2Excel(frm As Form, Optional strSheetName As String)
' frm is the name of the form you want to send to Excel
' strSheetName is the name of the sheet you want to name it to

   
    Dim rst As DAO.Recordset
    Dim ApXL As Object
    Dim xlWBk As Object
    Dim xlWSh As Object
    Dim fld As DAO.Field
    Const xlCenter As Long = -4108
    Const xlBottom As Long = -4107

    On Error GoTo err_handler

    Set rst = frm.RecordsetClone

 

    Set ApXL = CreateObject("Excel.Application")
    Set xlWBk = ApXL.Workbooks.Add
    ApXL.Visible = True
       
    Set xlWSh = xlWBk.Worksheets("Sheet1")
    If Len(strSheetName) > 0 Then
        xlWSh.Name = Left(strSheetName, 34)
    End If
    xlWSh.Activate
    xlWSh.Range("A1").Select

 


    For Each fld In rst.Fields
        ApXL.ActiveCell = fld.Name
        ApXL.ActiveCell.Offset(0, 1).Select
    Next

    rst.MoveFirst
    xlWSh.Range("A2").CopyFromRecordset rst
    xlWSh.Range("1:1").Select
    ' This is included to show some of what you can do about formatting.
    'You can comment out or delete
    ' any of this below that you don't want to
    'use in your own export.
    With ApXL.Selection.Font
        .Name = "Arial"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
    End With
    ApXL.Selection.Font.Bold = True
    With ApXL.Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .MergeCells = False
    End With
    ' selects all of the cells
    ApXL.ActiveSheet.Cells.Select
    ' does the "autofit" for all columns
    ApXL.ActiveSheet.Cells.EntireColumn.AutoFit
    ' selects the first cell to unselect all cells
    xlWSh.Range("A1").Select

 

    rst.Close
    Set rst = Nothing

    Exit Function
err_handler:
    DoCmd.SetWarnings True
    MsgBox Err.Description, vbExclamation, Err.Number
    Exit Function

End Function

And here is how I currently call this module:

Private Sub Command64_Click()
Call Send2Excel(Me.VP_Counts_Subform.Form, "VP Counts")
Call Send2Excel(Me.RVP_Counts_Subform.Form, "RVP Counts")
End Sub

It won't let me pass more than one subform when I call Send2Excel, so I have to list it twice, which opens two excel files.

Any help would be MUCH appreciated!

 

[GinaWhipp]

Yes, this is correct. This line...

Set xlWSh = xlWBk.Worksheets("Sheet1")

...determines which Worksheet. So, you would need to add additional lines to first choose the same Workbook and then add lines for Sheet2. Probably easier to use another Function for that after you save the initial Workbook and assign it a name.

 

[acarterczyz]

Yes, this is correct. This line...

Set xlWSh = xlWBk.Worksheets("Sheet1")

...determines which Worksheet. So, you would need to add additional lines to first choose the same Workbook and then add lines for Sheet2. Probably easier to use another Function for that after you save the initial Workbook and assign it a name.

I'm not certain how that would work. I've tried using the following, but it crashes everytime I attempt to use it...

Option Compare Database


Public Function Send2ExcelMultiple(frm As Form, Optional strSheetName As String, Optional frm2 As Form, Optional strSheetName2 As String)
' frm is the name of the form you want to send to Excel
' strSheetName is the name of the sheet you want to name it to

   
    Dim rst As DAO.Recordset
    Dim ApXL As Object
    Dim xlWBk As Object
    Dim xlWSh As Object
    Dim xlWSh2 As Object
    Dim fld As DAO.Field
    Const xlCenter As Long = -4108
    Const xlBottom As Long = -4107

    On Error GoTo err_handler

    Set rst = frm.RecordsetClone

 

    Set ApXL = CreateObject("Excel.Application")
    Set xlWBk = ApXL.Workbooks.Add
    ApXL.Visible = True
       
    Set xlWSh = xlWBk.Worksheets("Sheet1")
    If Len(strSheetName) > 0 Then
        xlWSh.Name = Left(strSheetName, 34)
    End If
    xlWSh.Activate
    xlWSh.Range("A1").Select

 


    For Each fld In rst.Fields
        ApXL.ActiveCell = fld.Name
        ApXL.ActiveCell.Offset(0, 1).Select
    Next

    rst.MoveFirst
    xlWSh.Range("A2").CopyFromRecordset rst
    xlWSh.Range("1:1").Select
    ' This is included to show some of what you can do about formatting.
    'You can comment out or delete
    ' any of this below that you don't want to
    'use in your own export.
    With ApXL.Selection.Font
        .Name = "Arial"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
    End With
    ApXL.Selection.Font.Bold = True
    With ApXL.Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = True
        .MergeCells = False
    End With
    ' selects all of the cells
    ApXL.ActiveSheet.Cells.Select
    ' does the "autofit" for all columns
    ApXL.ActiveSheet.Cells.EntireColumn.AutoFit
    ' selects the first cell to unselect all cells
    xlWSh.Range("A1").Select
    
 '
 '
 '
 
  Set xlWSh2 = xlWBk.Worksheets("Sheet2")
    If Len(strSheetName2) > 0 Then
        xlWSh2.Name = Left(strSheetName2, 34)
    End If
    xlWSh2.Activate
    xlWSh2.Range("A1").Select

 


    For Each fld In rst.Fields
        ApXL.ActiveCell = fld.Name
        ApXL.ActiveCell.Offset(0, 1).Select
    Next

    rst.MoveFirst
    xlWSh2.Range("A2").CopyFromRecordset rst
    xlWSh2.Range("1:1").Select
    ' This is included to show some of what you can do about formatting.
    'You can comment out or delete
    ' any of this below that you don't want to
    'use in your own export.
    With ApXL.Selection.Font
        .Name = "Arial"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
    End With
    ApXL.Selection.Font.Bold = True
    With ApXL.Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = True
        .MergeCells = False
    End With
    ' selects all of the cells
    ApXL.ActiveSheet.Cells.Select
    ' does the "autofit" for all columns
    ApXL.ActiveSheet.Cells.EntireColumn.AutoFit
    ' selects the first cell to unselect all cells
    xlWSh.Range("A1").Select

 

    rst.Close
    Set rst = Nothing

    Exit Function
err_handler:
    DoCmd.SetWarnings True
    MsgBox Err.Description, vbExclamation, Err.Number
    Exit Function

End Function

Basically with this, I copied the key portions and renamed it, applying to to Sheet 2..

 

[GinaWhipp]

But you need to specify the which Workbook. What is the Workbook name from the first routine?

 

[acarterczyz]

But you need to specify the which Workbook. What is the Workbook name from the first routine?

It creates a new workbook, not one that already exists.

 

[GinaWhipp]

Well, that is the problem, you need a *saved* Workbook to access Sheet2. Do you give it a *standardized* name?

 

[acarterczyz]

The goal is to not have a saved version, as not all our users have access to a shared drive. When it opens, its automatically named Book1.xlsx.

 

[GinaWhipp]

So after it opens and everyone views the information they close without saving?

 

[acarterczyz]

So after it opens and everyone views the information they close without saving?

Yes. The script I have shown above does that. It opens a brand new Excel file, transfers the contents of the subform I pass to it, and shows it to the user. There is no need to save the information, at least not for the reasons we are using it.

 

[GinaWhipp]

Hmm, then you need to push both Worksheets out at the same time in the same Function you can't use two separate lines (Functions). I have never done that with a Workbook that is not saved, how hard can it be I'm going to have to *play* with the first section of code you posted...

 

[acarterczyz]

Hmm, then you need to push both Worksheets out at the same time in the same Function you can't use two separate lines (Functions). I have never done that with a Workbook that is not saved, how hard can it be I'm going to have to *play* with the first section of code you posted...

I tried adding to that function, allowing me to pass two subforms, but it would not work. I'm somewhat new to VBA. Thanks for playing around with it! The original code works splendidly and we have been using it for a few years.

 

[GinaWhipp]

Just had a thought, can you upload a sample database? I'm going to *waste* some time creating one to play with and it would be better if I had one that closely represented yours.

 

[acarterczyz]

Just had a thought, can you upload a sample database? I'm going to *waste* some time creating one to play with and it would be better if I had one that closely represented yours.

I attached something I threw together very quickly. Unfortunately, I cannot send my file as it contains some sensitive work data. Each form in the attached database exports to the Excel file. The ALL button does not work, as this would be a good place to have all the other subforms combined into 1 workbook.

 

[GinaWhipp]

Great! Thanks a lot. My day just got a little crowded but I promise I am working on it!

 

[GinaWhipp]

Okay, so I got the two subforms (see Form Mortgage) to export to the same Workbook but have not figured out why I can only get Headings on the first Worksheet and not on the second. I did have to move the Module to behind the Form because I had to reference the second subform and that was much easier. Code not pretty but so far it's working!

Have a look...

 

[acarterczyz]

Okay, so I got the two subforms (see Form Mortgage) to export to the same Workbook but have not figured out why I can only get Headings on the first Worksheet and not on the second. I did have to move the Module to behind the Form because I had to reference the second subform and that was much easier. Code not pretty but so far it's working!

Have a look...

You were missing this for the second tab:

        For Each fld In rst2.Fields
        ApXL.ActiveCell = fld.Name
        ApXL.ActiveCell.Offset(0, 1).Select
    Next

It seems to be working now. Thank you!!

Edit: I also added to the function parameters and added the second sheet name to the Call.

Optional strSheetName2 As String

 

[acarterczyz]

One last thing (its minor, I promise).. Is there a way to delete sheet 3 in the VBA, since it will not be used?

 

[GinaWhipp]

I see you got the other parts working great! As for deleting the last page, well i'm having my car serviced... So, I guess it's a race to see who can post the answer first! . I'll check back when I can type on something bigger than my phone!

 

[acarterczyz]

I see you got the other parts working great! As for deleting the last page, well i'm having my car serviced... So, I guess it's a race to see who can post the answer first! . I'll check back when I can type on something bigger than my phone!

Got it. Surprised how easy that one was. I think I'm catching on to VBA LOL. Thanks again Gina!!

    ApXL.Sheets("Sheet3").Select
    ApXL.DisplayAlerts = False
    ApXL.ActiveSheet.Delete
    ApXL.DisplayAlerts = True

 

[GinaWhipp]

Saw that you got earlier but just wanted to say... GREAT JOB!