exporting 2 querris in one excel sheet

[benjamin.grimm]

hello guys i´ve got the follwing code

On Error GoTo ErrorHandler
    Dim exApp As Excel.Application
    Dim exDoc As Excel.Workbook
    Dim exSheet As Excel.Worksheet
    Dim Dateiname As String
    Dim SQL As String
    Dim Strich As String
    Dim strdat As String
    Dim i, J, K As Integer
    'DAO
    Dim db As DAO.Database
    Dim rsIn As DAO.Recordset
    Dim rsOut As DAO.Recordset
    
    '---- List 1 ---------
    Set db = CurrentDb
    Set rsOut = db.OpenRecordset("Land_alle_gew", dbOpenDynaset)
    rsOut.MoveLast
    Anzahl = rsOut.RecordCount
    rsOut.MoveFirst
    rsOut.Close
    Dateiname = "C:\Test\"
    Dateiname = Dateiname & Format(Now, "yyyymmdd") & "Export1.xls"
    strdat = Dateiname
    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "Land_alle_gew" _
                            , Dateiname, True, "Blatt1"
    Set exDoc = CreateObject(Dateiname)
    exDoc.Windows(1).Visible = True
    If Err <> 0 Or exDoc Is Nothing Then
        Beep
        MsgBox "Arbeitsmappe kann nicht angelegt/geoeffnet werden: " _
             & Err.Description, vbOKOnly, vbCritical, "!!! Problem !!!"
        Exit Sub
    End If
    Set exSheet = exDoc.ActiveSheet
    exSheet.Range("A1:L1").Font.Size = 10
    exSheet.Range("A1:L1").Font.Bold = True
    exSheet.Name = "Blatt1"
    exDoc.Save
    '------------List 2 ----------------
    Set db = CurrentDb
    Set rsOut = db.OpenRecordset("Land_alle_verl", dbOpenDynaset)
    rsOut.MoveLast
    Anzahl = rsOut.RecordCount
    rsOut.MoveFirst
    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "Land_alle_verl" _
                            , Dateiname, True, "Blatt2"
    Set exDoc = CreateObject(Dateiname)
    exDoc.Windows(1).Visible = True
    Set exSheet = exDoc.ActiveSheet
    exSheet.Range("A1:L1").Font.Size = 10
    exSheet.Range("A1:L1").Font.Bold = True
    exSheet.Name = "Blatt2"
    Set exApp = exDoc.Application
    exApp.Visible = True
    exDoc.Save
    AppActivate exApp.Caption
ExitSub:
    On Error Resume Next
    Set rsOut = Nothing
    Set db = Nothing
    Exit Sub
ErrorHandler:
    MsgBox "Fehler " & CStr(Err) & ": " & Err.Description
    Resume ExitSub

I´ll get the following error:

error message 1004: can not give a sheet, the same name of the sheet

 

[pr2-eugin]

Which line does the error occur??

 

[DavidAtWork]

have you tried a simpler approach by simply creating 2 queries equivalent to your 2 recordsets (name them Blatt1, Blatt2), then export them to the same workbook using the TransferSpreadsheet method, this will create a workbook with 2 worksheets named Blatt1, Blatt2, then you can go about trying to format certain cell ranges on each sheet

David

 

[benjamin.grimm]

Thanks you guys.

i figured it out

 

[pr2-eugin]

You could share the solution, so someone could benefit from this in the future?

 

[benjamin.grimm]

I solved the probelm with s-references in Excel so without Access

 

[benjamin.grimm]

where is this solved button?

 

[pr2-eugin]

The option to mark a thread as Solved is under thread tools,