Export of all ID´s via VBA

[benjamin.grimm]

hello,

i export contracts via VBA from access to excel.
In total i have around 200 contracts.

In Excel i create a diagram by the exported datas.

The diagram have to be in excel.

The vba code export all the data, but i have to create the sheets before.

[FONT=Courier New]            Set xlSheet = xlBook.Sheets("Tabelle " & rstID.Fields("SuWID"))
            xlSheet.Name = "ID" & rstID.Fields("SuWID")[/FONT]

So for ID 1 i have to create the Tabelle1 and for ID 140 i have to create the table 140.

So i usually create 200 same sheets.

If a contract gets deleted then the sheet with the special ID is empty.

How can i do it without creating the sheets before?

Here the complete code:

[FONT=Courier New]Private Sub Befehl1_Click()
    Dim xlApp As Object         'Excel.Application
    Dim xlBook As Object        'Excel.Workbook
    Dim xlSheet As Object       'Excel.Worksheet
    Dim rstID As DAO.Recordset, tmpStr As String
    Dim rstGr As DAO.Recordset, strSQL As String
 
    strSQL = "SELECT SuWID FROM Abfrage_alles GROUP BY SuWID;"
    Set rstID = CurrentDb.OpenRecordset(strSQL)
    If Not rstID.EOF Then
        Set xlApp = CreateObject("Excel.Application")
        xlApp.Visible = True
        Set xlBook = xlApp.WorkBooks.Open("S:\xyz\Auswertung-komplett.xlsm")
        Do While Not rstID.EOF
            Set xlSheet = xlBook.Sheets("Tabelle " & rstID.Fields("SuWID"))
            xlSheet.Name = "ID" & rstID.Fields("SuWID")
            strSQL = "SELECT SAP, Geris, Pauschale, SuWID, Jahr_Y, BT_Name" _
                        & ", SAP_Nummer, Vertragsbeginn, Vertragsende" _
                    & " FROM Abfrage_alles" _
                   & " WHERE SuWID = " & rstID.Fields("SuWID")
            Set rstGr = CurrentDb.OpenRecordset(strSQL)
            xlSheet.Range("A6").CopyFromRecordset rstGr
            rstGr.Close
            rstID.MoveNext
        Loop
      Else
        MsgBox "No information to export", vbInformation, "No data exported"
    End If
    rstID.Close
    Set rstID = Nothing
    Set xlSheet = Nothing
    Set xlBook = Nothing
    Set xlApp = Nothing
End Sub[/FONT]

Greetz Benjamin

 

[JHB]

Why not start with one sheet in the Excel file, and then at runtime copy and rename it?

 

[benjamin.grimm]

That´s what i acutally would like to have.

I just want to have one sheet and then at runtime copy it and rename it.

but how does that work?

 

[JHB]

Here is a link to the description how you do it, (remember to use your references to the Excel object you create).
http://msdn.microsoft.com/en-us/library/office/ff837784(v=office.15).aspx

 

[benjamin.grimm]

Thanks for your help!

I changed the code to the following:

        Do While Not rstID.EOF
  
           Set xlSheet = xlBook.Sheets("Tabelle1")
 
            Set rstGr = CurrentDb.OpenRecordset("SELECT SAP, Geris, Pauschale, SuWID, Jahr_Y, Monat_X, BT_Name, Vertragsbeginn, Vertragsende, Anzahl_Fahrzeuge, Laufzeit_des_Vertrags FROM Abfrage_alles WHERE SuWID = " & rstID.Fields("SuWID"))
            
            MsgBox "Das Ergebniss  " & rstID.Fields("SuWID")
    
            xlSheet.Range("A6").CopyFromRecordset rstGr
            xlSheet("Tabelle1").Copy After:=xlSheet("Tabelle1")
            xlSheet("Tabelle1").Name = rstID.Fields("SuWID")
                 
            rstGr.Close
            rstID.MoveNext
        Loop

Now i get a runtime error 438 on the line

xlSheet("Tabelle1").Copy After:=xlSheet("Tabelle1")


Do you know the reason?

 

[JHB]

What if you left out the "After:=xlSheet("Tabelle1")" part?

            xlSheet("Tabelle1").Copy

Which version of MS-Access and Excel do you use?

 

[benjamin.grimm]

I use access 2010 and excel 2010.

I tried already a lot.

I changed the code also.

Now it works, but there is one more problem.

I want that the Name is the ID and not ID (2)

So right now the system names them 2(2), 3(3).

I have a logical mistake somewhere, but i cant find it.

        Do While Not rstID.EOF
  
           Set xlsheet = xlBook.sheets("Tabelle1")
 
            Set rstGr = CurrentDb.OpenRecordset("SELECT SAP, Geris, Pauschale, SuWID, Jahr_Y, Monat_X, BT_Name, Vertragsbeginn, Vertragsende, Anzahl_Fahrzeuge, Laufzeit_des_Vertrags FROM Abfrage_alles WHERE SuWID = " & rstID.Fields("SuWID"))
            
            MsgBox "Das Ergebniss  " & rstID.Fields("SuWID")
    
            MsgBox "import"
            xlsheet.Range("A6").CopyFromRecordset rstGr
            
            MsgBox "name it"
            xlsheet.Name = rstID.Fields("SuWID")
            
            MsgBox "copy it"
            
            xlsheet.Copy After:=xlsheet
            
            MsgBox "select"
            
            xlsheet.Select
            
            MsgBox "name the new sheet"
            
            xlsheet.Name = "tabelle1"
              
            rstGr.Close
            rstID.MoveNext
        Loop

Greeting Benjamin

 

[JHB]

Try the below code:

  Dim xlApp As Object         'Excel.Application
  Dim xlBook As Object        'Excel.Workbook
  Dim xlSheet As Object       'Excel.Worksheet
  Dim rstID As DAO.Recordset, tmpStr As String
  Dim rstGr As DAO.Recordset, strSQL As String
  
  strSQL = "SELECT SuWID FROM Abfrage_alles GROUP BY SuWID;"
  Set rstID = CurrentDb.OpenRecordset(strSQL)
  If Not rstID.EOF Then
    Set xlApp = CreateObject("Excel.Application")
    xlApp.Visible = True
    Set xlBook = xlApp.WorkBooks.Open("S:\xyz\Auswertung-komplett.xlsm")
    Do While Not rstID.EOF
      Set xlSheet = xlBook.sheets("Tabelle1")
      Set rstGr = CurrentDb.OpenRecordset("SELECT SAP, Geris, Pauschale, SuWID, Jahr_Y, Monat_X, BT_Name, Vertragsbeginn, Vertragsende, Anzahl_Fahrzeuge, Laufzeit_des_Vertrags FROM Abfrage_alles WHERE SuWID = " & rstID![SuWID])
      xlSheet.Copy Before:=xlSheet
      xlBook.sheets("Tabelle1 (2)").Name = rstID![SuWID]
      xlBook.sheets(CStr(rstID![SuWID])).Range("A6").CopyFromRecordset rstGr
      rstGr.Close
      rstID.MoveNext
    Loop
  End If
  rstID.Close
  Set rstID = Nothing
  Set xlSheet = Nothing
  Set xlBook = Nothing
  Set xlApp = Nothing

 

[benjamin.grimm]

great. thank you that works!

 

[benjamin.grimm]

I dont know how to put the thread on solved!

greetz benjamin

 

[JHB]

great. thank you that works!

You're welcome, luck with your project.
To mark it as solved - look at the top where the "Thread" start, it is under the "Thread tools".