title image


Smiley Re: Recordset in Excel speichern ???
Ich machs so:







      

 Public  Sub Export( ByRef RecSet  As recordset,  ByVal ExpPfad  As  String)



     On  Error  GoTo fehler



     Dim i         As  Long

     Dim x         As  Long

     Dim y         As  Long

     Dim xlsApp    As  Object

     Dim xlsMappe  As  Object

     Dim xlsSheet  As  Object



     Set xlsApp = CreateObject("Excel.Application")

     Set xlsMappe = xlsApp.Workbooks.Add



     If xlsMappe.Worksheets.Count > 1  Then

        xlsApp.DisplayAlerts =  False

         For i = xlsMappe.Worksheets.Count  To 2  Step -1

            xlsMappe.Worksheets(i).Delete

         Next

        xlsApp.DisplayAlerts =  True

     End  If



     Set xlsSheet = xlsMappe.Worksheets(1)



     For x = 0  To RecSet.Fields.Count - 1

        xlsSheet.Cells(1, x + 1) = RecSet.Fields(x).Name

     Next



    RecSet.MoveFirst

    y = 1



     On  Error  Resume  Next



     While  Not RecSet.EOF

         For x = 0  To RecSet.Fields.Count - 1

            xlsSheet.Cells(y + 1, x + 1) = RecSet.Fields(x).Value

         Next

        RecSet.MoveNext

        y = y + 1

     Wend



    xlsMappe.SaveAs ExpPfad



     On  Error  Resume  Next

    xlsMappe.Close

    xlsApp.Quit

     Set xlsApp =  Nothing

    RecSet.MoveFirst



     Exit  Sub

    

fehler:

    MsgBox "Leider ist beim Exportieren ein Fehler aufgetreten.", vbExclamation



 End  Sub 









Weiß aber nicht obs vielleicht doch einfacher geht :-)





geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: