PDA

Vollständige Version anzeigen : Export nach Excel von Formular mit CopyFromRecordset-Methode


ios707
15.01.2010, 12:42
Hallo zusammen,

so was habe ich hier vor ein paar Tagen mal gesucht, es aber nie wirklich ausführlich beschrieben gesehen. Also dachte ich mir, stelle ich es ein ... nach so etwas ähnlichem haben schon viele Leute hier gefragt.

Der Code ist für einen Button gedacht, der auf einem Hauptformular liegt. Das Hauptformular enthält ein Unterformular, in dem die Daten angezeigt werden. Der Code muss nur an einer Stelle angepasst werden, nämlich der Name des Steuerelements, das das Unterformular enthält.

Ich hoffe es hilft dem einen oder anderen ...


Private Sub cmdXLSExport_Click()
' Export aller Daten des Unterformulars nach Excel mit CopyFromRecordset-Methode
Dim iCols As Integer
Dim rs As Recordset
Dim ws As Object
Dim wb As Object
Dim ExcelApp As Object

' Neue Excel Datei, Arbeitsmappe und Worksheet erstellen
Set ExcelApp = CreateObject("Excel.Application")
Set wb = ExcelApp.Workbooks.Add
Set ws = ExcelApp.Worksheets.Add
' Recordset des Unterformulars kopieren,
' hier muss der Name des Steuerelements, das das Unterformular enthält, angepasst werden
'---------------
Set rs = Me!NameSteuerelement.Form.RecordsetClone
'---------------
' Nur was machen, wenn Daten vorhanden sind
If Not rs.EOF Then
rs.MoveFirst
' Daten nach Excel kopieren
For iCols = 0 To rs.Fields.Count - 1
ws.Cells(1, iCols + 1).Value = rs.Fields(iCols).Name
Next
ws.Range(ws.Cells(1, 1), _
ws.Cells(1, rs.Fields.Count)).Font.Bold = True
ws.Range("A2").CopyFromRecordset rs
End If
' Excel sichtbar machen
ExcelApp.Visible = True

' Alles resetten
Set ws = Nothing
Set wb = Nothing
Set ExcelApp = Nothing
End Sub

ios707
17.01.2010, 17:47
Ich hatte wohl nicht gründlich genug gesucht, Josef hat nämlich auch schon mal was ähnliches geschrieben, nur noch besser ;)

http://www.ms-office-forum.net/forum/showpost.php?p=1166062&postcount=14

ios707
13.02.2010, 11:06
Hier ein kleines Update. Die Spaltenbreite in Excel wird jetzt auch noch automatisch angepasst und die Handhabung ist viel leichter nach Anlehnung an die Ideen von Josef.

Der Code kommt nun bspw. in ein Modul:


Public Sub XLSExportRS(rs As Recordset)
' Export aller Daten des Unterformulars nach Excel mit CopyFromRecordset-Methode
' David Niegisch, 10.02.2010
Dim iCols As Integer
Dim ws As Object
Dim wb As Object
Dim ExcelApp As Object
' Neue Excel Datei, Arbeitsmappe und Worksheet erstellen
Set ExcelApp = CreateObject("Excel.Application")
Set wb = ExcelApp.Workbooks.Add
Set ws = ExcelApp.Worksheets.Add
' Nur ausführen wenn Daten vorhanden sind
If Not rs.EOF Then
rs.MoveFirst
' Daten nach Excel kopieren
For iCols = 0 To rs.Fields.Count - 1
ws.Cells(1, iCols + 1).Value = rs.Fields(iCols).Name
Next
ws.Range(ws.Cells(1, 1), _
ws.Cells(1, rs.Fields.Count)).Font.Bold = True
ws.Range("A2").CopyFromRecordset rs
End If
ws.Columns.AutoFit
' Excel sichtbar machen und alles resetten
ExcelApp.Visible = True
Set ws = Nothing
Set wb = Nothing
Set ExcelApp = Nothing
End Sub


Und der Aufruf erfolgt mit:


XLSExportRS Me!Unterformular.Form.RecordsetClone

ios707
25.02.2010, 08:04
Noch ein Update:

- Bugfix: der Code konnte bislang nicht mehrmals hintereinander ausgeführt werden, weil nach der ersten Ausführung der DS-Marker des Recordsets am Ende steht. Ein MoveFirst an der richtigen Stelle schafft Abhilfe.
- Ergänzung: Meldung, wenn keine Daten für den Export vorliegen und in diesem Fall auch kein unnötiges Anlegen von Excel-Instanzen.

Der Code kommt nach wie vor in ein Modul:

Public Sub XLSExportRS(rs As Recordset)
' Export aller Daten des Unterformulars nach Excel mit CopyFromRecordset-Methode
' David Niegisch, 25.02.2010
Dim gsMsgAntw As Integer
Dim iCols As Integer
Dim ws As Object ' falls Verweise auf die Excel-Bibl. gesetzt sind, kann man sich late binding sparen, Excel.Worksheet
Dim wb As Object ' falls Verweise auf die Excel-Bibl. gesetzt sind, kann man sich late binding sparen, Excel.Workbook
Dim ExcelApp As Object ' falls Verweise auf die Excel-Bibl. gesetzt sind, kann man sich late binding sparen, Excel.Application

' MoveFirst sorgt dafür, dass die gleichen Daten auch mehrmals hintereinander exportiert werden können
rs.MoveFirst

' Nur ausführen wenn Daten vorhanden sind
If rs.EOF Then
gsMsgAntw = MsgBox("Es sind keine Ergebnisse für einen Export vorhanden!", vbInformation, "Export nicht moeglich")
Else
' Neue Excel Datei, Arbeitsmappe und Worksheet erstellen
Set ExcelApp = CreateObject("Excel.Application")
Set wb = ExcelApp.Workbooks.Add
Set ws = ExcelApp.Worksheets.Add
' Daten nach Excel kopieren
' Feld- bzw. Spaltennamen
For iCols = 0 To rs.Fields.Count - 1
ws.Cells(1, iCols + 1).Value = rs.Fields(iCols).Name
Next
' Daten
ws.Range(ws.Cells(1, 1), _
ws.Cells(1, rs.Fields.Count)).Font.Bold = True
ws.Range("A2").CopyFromRecordset rs
' Spaltenbreite anpassen
ws.Columns.AutoFit
' Excel sichtbar machen und alles resetten
ExcelApp.Visible = True
Set ws = Nothing
Set wb = Nothing
Set ExcelApp = Nothing
End If

End Sub


Wenn der Code von einem Hauptformular aus die Daten eines Unterformulars exportieren soll, dann erfolgt der Aufruf mit:

XLSExportRS Me!Unterformular.Form.RecordsetClone

"Unterformular" ist dabei der Name des Steuerelements auf dem Hauptformular, in dem das Unterformular steckt.

swati
03.03.2010, 11:09
sehr schöner Code!

und funktioniert prima

cpac
30.03.2010, 14:59
Falls sich ein Feld vom Datentyp Memo im Recordset befindet, kommt es bei Verwendung von CopyFromRecordset zu einem Fehler, wenn sich mehr als 910 Zeichen in dem Memo-Feld befinden. Dies als Information (aus leidvoller Erfahrung...).

In einem solchen Fall ist dann DoCmd.TransferSpreadsheet eine funktionierende Lösung.

ios707
31.03.2010, 14:33
Danke für den Hinweis Carsten. Habe mal etwas nachgeforscht und eine Lösung für das Problem mit den Memo-Feldern gefunden, die ich selbst noch nicht ausprobiert habe.

Anscheinend ist es kein Problem, das Memo-Feld erst mal an eine Variable zu übergeben und dann den Inhalt der Variablen weiterzuverwenden, bspw. so

foo = rstcheck![Field Memo]
objsheet2.cells(4,2).value = foo

Quelle: http://www.utteraccess.com/forum/CopyFromRecordset-Woes-t648294.html&p=648781#entry648781

Wie gesagt, nicht selber getestet und werde es in naher Zukunft wohl auch nicht machen, da ich das nicht brauche und genug andere Sachen zu tun habe ;)

HO2013
23.07.2013, 11:44
super code.

vielen dank. funktioniert einwandfrei.

JonnyMM
01.03.2014, 23:11
Vielen Dank für das tolle Forum, wo man als Anfänger immer wieder Hilfestellung findet. Ich hatte das Problem, dass der Export einer Abfrage mit einem ähnlichen Code wie oben mitgeilt nur einmal funktionierte. Jetzt habe ich auch für das Problem die Lösung gefunden
Beste Grüße, JonnyMM

Donnervogel
16.10.2014, 11:04
Moin,

wie funktioniert das jetzt genau? Ich kopiere den Code in ein neues Modul.
Wie kann ich das dann Asuführen? Will da so eine Schaltfläche haben, dass der Export ausgeführt wird, wenn ich draufklicke.
Kann mir da jemand helfen?

uthterii
20.04.2015, 08:56
Bugfix: der Code konnte bislang nicht mehrmals hintereinander ausgeführt werden, weil nach der ersten Ausführung der DS-Marker des Recordsets am Ende steht. Ein MoveFirst an der richtigen Stelle schafft Abhilfe.????

ios707
27.05.2015, 13:02
Bugfix: der Code konnte bislang nicht mehrmals hintereinander ausgeführt werden, weil nach der ersten Ausführung der DS-Marker des Recordsets am Ende steht. Ein MoveFirst an der richtigen Stelle schafft Abhilfe.????

Einfach den Code vom 25.02.2010 verwenden, das ist das MoveFirst bereits eingebaut (erste Zeile nach der Variablendeklaration)