Office: (Office 2003) Daten aus Access nach Excel direkt übergeben

heddabach · 17. Juli 2007

Hallo!

Ich habe das Problem, dass ich über einen Button aus einem Formular heraus, Daten aus der Abfrage "qry_Jubiläumsdienstzeit" direkt nach Excel übergeben will.

Ich habe mir aus einer Beispieldatenbank folgenden Code kopiert und abgeändert:

Code:

Private Sub cmd_Daten_nach_Excel_Click()

Dim oExcel As Excel.Application, DB As DAO.Database, RS As DAO.Recordset, I As Long
On Error Resume Next
Err.Clear
Set oExcel = GetObject(, "Excel.Application ")
If Err.Number 0 Then Set oExcel = CreateObject("Excel.Application")
On Error GoTo 0
With oExcel
.Visible = True
.Workbooks.Add
' Set RS = Me.RecordsetClone
Set DB = CurrentDb
Set RS = DB.OpenRecordset("qry_Jubiläumsdienstzeit", dbOpenSnapshot)
For I = 0 To RS.Fields.Count - 1
.Cells(1, I + 1) = RS.Fields(I).NAME
Next I
.Range("A2").Select
.Selection.CopyFromRecordset RS
End With

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Leider funktioniert er nicht!

Ein Screenshot inkl. Fehlermeldung habe ich hier angehängt!

Fehler beim Kompilieren: Benutzerdefinierter Typ ist nicht definiert!
"oExcel As Excel.Application" ist im Code markiert!

Bitte helft mir, den Code so anzupassen, dass er funktioniert!

Vielen Dank für eure Hilfe!
heddabach

[Edit] Mof-Team AD: Aus dem Code-Archiv ins Access-Forum verschoben und aus Thread #1 zu diesem Problem. [/Edit]

:)

JBond · 19. Juli 2007

Hi,

schau mal, ob du bei Extras-> Verweise die Microsoft Excel Object Library markiert hast - da sollte das imho enthalten sein.

Gruß,
JBond

PS:
Solche Fragen kommen normalerweise ins normale Excel-Forum - nicht ins Code Archiv *wink.gif*

[Edit] Mof-Team AD: Aus dem Code-Archiv ins Access-Forum verschoben und aus Thread #1 zu diesem Problem. [/Edit]

heddabach · 19. Juli 2007

SORRY! Ich habe den ersten Beitrag ins falsche Forum geschrieben!
Das war der erste Beitrag: http://www.ms-office-forum.net/forum...d.php?t=214193
Das Problem ist gelöst! Vielen Dank dafür!

JETZT ist aber noch ein weiter Fehler aufgetreten:

Einleitung zum Verständnis des Problems:
Ich habe das Problem, dass ich über einen Button aus einem Formular heraus, Daten aus der Abfrage "qry_Jubiläumsdienstzeit" direkt nach Excel übergeben will.

Ich habe mir aus einer Beispieldatenbank folgenden Code kopiert und abgeändert:

Code:

Private Sub cmd_Daten_nach_Excel_Click()

Dim oExcel As Excel.Application, DB As DAO.Database, RS As DAO.Recordset, I As Long
On Error Resume Next
Err.Clear
Set oExcel = GetObject(, "Excel.Application ")
If Err.Number 0 Then Set oExcel = CreateObject("Excel.Application")
On Error GoTo 0
With oExcel
.Visible = True
.Workbooks.Add
' Set RS = Me.RecordsetClone
Set DB = CurrentDb
Set RS = DB.OpenRecordset("qry_Jubiläumsdienstzeit", dbOpenSnapshot)
For I = 0 To RS.Fields.Count - 1
.Cells(1, I + 1) = RS.Fields(I).NAME
Next I
.Range("A2").Select
.Selection.CopyFromRecordset RS
End With

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Leider funktioniert er nicht!

Ein Screenshot inkl. Fehlermeldung habe ich hier angehängt!

Laufzeitfehler '3061'! usw.
"Set RS = DB.OpenRecordset("ZZ_Jubiläumsdienstzeit", dbOpenSnapshot)" ist im Code markiert!

Bitte helft mir, den Code so anzupassen, dass er funktioniert!

Vielen Dank für eure Hilfe!
heddabach

[Edit] Mof-Team AD: Aus Thread #2 zu diesem Problem. [/Edit]

Inti31 · 19. Juli 2007

Für einen Export von Daten einer Query nach Excel nutze ich eine temp. Tabelle (tmp_tbl), die ich dann mittels
Code:

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "tmp_tbl", filepath, True
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

wegspeichere und abschließend lösche.

Beispiel anhand eines Select-Case-Statements:
Code:

dim filepath as string
Dim deltmp As String
Dim con As Object
Dim rs As Object
Dim variablex As String
Dim yourchoose as String

Public Sub SaveInExcelDatei (Optional yourchoose As String, Optional Nr As String)

On Error resume next ' falls nicht vorhanden
deltmp = "drop table tmp_tbl"
CurrentProject.Connection.Execute deltmp ' Löschen der vorhandenen temp. Tabelle
On Error Goto 0

Select Case yourchoose ' Auswahl auswerten.
'--------------------------------------------------------------------------
Case 1
yourchoose = "Zusatzname der zukünftigen Exceltabelle"
writetmp = "SELECT Tabelle.Feld1 AS [Wert1], Tabelle.Feld2 AS [Wert2] INTO tmp_tbl" _
& " FROM Tabelle" _
& " WHERE ... " _
& " ORDER BY Tabelle.Feld2;"
'--------------------------------------------------------------------------
Case 2
yourchoose = "Zusatzname der zukünftigen Exceltabelle1"
writetmp = "SELECT Tabelle.Feld1 AS [Wert1], Tabelle.Feld2 AS [Wert2] INTO tmp_tbl" _
& " FROM Tabelle" _
& " WHERE ... " _
& " ORDER BY Tabelle.Feld2;"
'--------------------------------------------------------------------------

Case Else ' Andere Abfragen

End Select

CurrentProject.Connection.Execute writetmp ' temp. Tabelle wird erzeugt

' Optional
Set con = Application.CurrentProject.Connection
Set rs = CreateObject("ADODB.Recordset")
rs.CursorLocation = adUseClient

rs.Open "SELECT tmp_tbl.Wert1, tmp_tbl.Nr FROM tmp_tbl " _
& " WHERE tmp_tbl.Nr = IrgendeinWert;", con

variablex = rs("Wert1") ' Hiermit wird aus der temp. Tabelle ein Wert ausgelesen, der als Speichername in Frage kommt

Set rs = Nothing
Set db = Nothing

filepath = DateiSpeichern("C:\", "XLS-Datei speichern", variablex & " (" & yourchoose & ").xls")

If (Empty filepath) Then
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "tmp_tbl", filepath, True
End If

CurrentProject.Connection.Execute deltmp ' Löschen der temp. Tabelle

end sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Die Funktion DateiSpeichern findest Du hier im Forum mehrfach.

Ein Aufruf erfolgt dann nur noch mit:
Code:

Call SaveInExcelDatei (yourchoose, Nr)
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

wobei Du hier vorangestellt noch einen zusätzlichen Wert übergeben kannst (hier Nr), je nachdem, wo von Du das ganze aufrufst.
Code:

Dim yourchoose As String
yourchoose = 1
Call SaveInExcelDatei (yourchoose, Nr)
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

PS: Die ist ein Beispiel, yourchoose / Nr kann auch vom Typ int sein

Gruß Inti31

PS: ich gebe meinem Vorposter recht - dieses hier ist das falsche Themenboard und gehört nach Microsoft Access

[Edit] Mof-Team AD: Aus dem Code-Archiv ins Access-Forum verschoben und aus Thread #1 zu diesem Problem. [/Edit]

Arne Dieckmann · 19. Juli 2007

zu Beitrag #3: Wenn die Abfrage Formularbezüge enthält, dann sollte FAQ 6.4 (Klick mich) helfen.

lalo · 19. Juli 2007

Hallo,

lauft die Abfrage überhaupt ?
Ist das "ä" evtl ein Problem, ich nutze vorsichtshalber nie Umlaute !

Hier eine Function die ich generell einsetzt und ggf. die Formatierung anpasse.

Code:

Public Function Export_Excel(sql_string As String, RC As Integer, SelCriteria As String)
Dim appXLS As Excel.Application
Dim wbkXLS As Excel.Workbook
Dim wksXLS As Excel.Worksheet
Dim rs As New ADODB.Recordset
Dim i As Long

'//Excelobjekt erstellen, Datei erstellen, neues Blatt einfügen
Set appXLS = CreateObject("Excel.Application")
Set wbkXLS = appXLS.Workbooks.Add
Set wksXLS = wbkXLS.Worksheets.Add

'//Tabellenblatt benennen und Recordset öffnen
'---- appXLS.Visible = True -- NUR FÜR TEST ----

wksXLS.Name = "OEE"
rs.Open sql_string, CurrentProject.Connection, adOpenForwardOnly, adLockOptimistic

'//Spaltenüberschriften erstellen
For i = 0 To rs.Fields.count - 1
wksXLS.Cells(1, i + 1) = rs.Fields(i).Name
Next i

'//Recordset kopieren, Formatierungen und Berechnungen
With wksXLS
'---- Recordset kopieren
.Range("A2").CopyFromRecordset rs

'---- Formatierungen der Überschrift
With .Range("A1:H1")
.Font.Name = "Arial"
.Font.Bold = True
.Font.Size = 10
.Font.Strikethrough = False
.Font.Superscript = False
.Font.Subscript = False
.Font.OutlineFont = False
.Font.Shadow = False
.Font.Underline = xlUnderlineStyleNone
.Font.ColorIndex = xlAutomatic
.Interior.ColorIndex = 17
.Interior.Pattern = xlSolid
.Interior.PatternColorIndex = xlAutomatic
End With
'---- Datumsspaletn formatieren -- BEISPIEL
With .Range("C:C")
' .Columns("c:c").Select
.NumberFormat = "m/d/yyyy"
End With
'---- Zeiten formatieren --- BEISPIEL
With .Range("D:E")
.NumberFormat = "h:mm:ss"
End With
'---- Menge formatieren --- BEISPIEL
With .Range("g:g")
.NumberFormat = "#,##0.000"
End With
With .Columns("A:z").Columns.AutoFit
End With
End With
Set wksXLS = Nothing

'---- Selektionskriterien in eigenes Workbook einfügen --- nur falls sinnvoll
If SelCriteria "" Then
Set wksXLS = wbkXLS.Worksheets.Add
With wksXLS
.Name = "Selektionskriterien"
.Range("A1") = SelCriteria
End With
Set wksXLS = Nothing
End If

'---- Speichern der Datei
On Error GoTo errorhandler
wbkXLS.SaveAs FileName:=DateiSpeichern("C:\temp\", "Speichern"), FileFormat:=xlNormal _
, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False

'---- Excel schließen usw.
wbkXLS.Close
appXLS.Quit
rs.Close

Set wksXLS = Nothing
Set wbkXLS = Nothing
Set appXLS = Nothing
Set rs = Nothing

Export_Excel = 1 ' --- Returncode für die aufrufende Procedur

Exit Function
errorhandler:

Export_Excel = 0 '---- MsgBox "Datei wurde nicht gespeichert"
Set wksXLS = Nothing
Set wbkXLS = Nothing
Set appXLS = Nothing
Set rs = Nothing

End Function
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Gruß Bernd

heddabach · 19. Juli 2007

Hallo Bernd!

Danke für deine Hilfe!

Ich habe die Function "Export_Excel" in ein neues Modul kopiert!

Ich versteh jetzt nur noch nicht, welchen Code ich bei dem Button des Formulars hinterlegen muss, damit die Function "Export_Excel" mit der Abfrage "qry_Jubilaeumsdienstzeit" ausgeführt wird!

Die Abfrage läuft einwandfrei! Vielen Dank für die bisherige Hilfe!

mfg
heddabach

JBond · 7. Januar 2021

von Arne Dieckmann

zu Beitrag #3: Wenn die Abfrage Formularbezüge enthält, dann sollte FAQ 6.4 (Klick mich) helfen.
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Hi heddabach,

hast du diesen Beitrag von Arne beachtet?

Ich denke besonders der Verweise auf die FAQ 6.16 darin sollte dir weiterhelfen, da du wohl eine Parameterabfrage verwendest, aber keine Parameter übergibst.

Gruß,
JBond

heddabach · 19. Juli 2007

Hallo JBond,

Ich habe mir die FAQ 6.16 schon angeschaut!

Die Abfrage, die die Daten liefert, hat Parameter! Die Abfrageprameter verweisen auf das geöffnete Fromular, in dem sich der Button befindet, der den Code starten soll.

Die Prarameter sind in den Textboxen des Formulars eingetragen.

Wenn das Formular geöffnet ist und ich die Abfrage manuell starte, funktioniert die Abfrage einwandfrei!

Tut mir leid, aber in bin noch nicht so fit in Access-VBA. Vielen Dank für eure Hilfe und Geduld.

mfg
heddabach

lalo · 20. Juli 2007

Hi heddabach,

Ich verwende hier keine gespeicherten Abfragen da ich die Query je nach Datenanfall dynamisch zusammenbaue. Ich sehe keinen Sinn darin eine Abfrage die nur an einer Stelle gebraucht wird zu speichern.

In der Sub DeinButton_Click:

Definiere eine Variable für den Returncode der Funktion
Dim Retcode as string
dann SqlString zusammenbauen
Retcode = Export_Excel(DeinSqlString, "", DeineSelektionskriterienImKlartext) '-- oder ""
If retcode 1 then
MsgBox "DeineFehlermeldung......
end if
Gruß Bernd

Arne Dieckmann · 20. Juli 2007

Die Abfrage funktioniert einwandfrei, allerdings kann DAO mit Formularbezügen nichts anfangen. Ändere die Formularbezüge nach FAQ 6.16 und es sollte funktionieren. Statt:
Code:

Formulare!NameDesFormulares!NameDesTextFeldes
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

also:
Code:

Eval("Forms!NameDesFormulares!NameDesTextFeldes")
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Wenn du es nicht hinbekommst, zeige die SQL-Ansicht deiner Abfrage und jemand wird dir die Abfrage umstricken.

heddabach · 23. Juli 2007

Hallo Arne,

Hier ist der SQL-Code der Abfrage:

Code:

SELECT [UNION (Personal+Personal_Austritte)].NACHNAME, [UNION (Personal+Personal_Austritte)].VORNAME, [UNION (Personal+Personal_Austritte)].GEB, [UNION (Personal+Personal_Austritte)].TELEFON, [UNION (Personal+Personal_Austritte)].EINTRITT, [UNION (Personal+Personal_Austritte)].[DV befristet], [UNION (Personal+Personal_Austritte)].[TÄTIG ALS], [UNION (Personal+Personal_Austritte)].KstNr, [UNION (Personal+Personal_Austritte)].[BEREICH _ HEIM], [UNION (Personal+Personal_Austritte)].[ABT _ GRUPPE], [UNION (Personal+Personal_Austritte)].[Jub_Dienstz AVR], IIf([Berechnung1]=25,[Berechnung1],IIf([Berechnung1]=40,[Berechnung1],IIf([Berechnung1]=50,[Berechnung1]))) AS [Ehrung für Jahre (AVR)], [UNION (Personal+Personal_Austritte)].[Jub_Dienstz DRW], IIf([Berechnung2]=10,[Berechnung2],IIf([Berechnung2]=15,[Berechnung2],IIf([Berechnung2]=20,[Berechnung2],IIf([Berechnung2]=30,[Berechnung2],IIf([Berechnung2]=35,[Berechnung2],IIf([Berechnung2]=45,[Berechnung2])))))) AS [Ehrung für Jahre (DRW)], IIf([Ehrung für Jahre (AVR)]"" And [Ehrung für Jahre (DRW)]"",2,1) AS [Anzahl Ehrungen], [UNION (Personal+Personal_Austritte)].PLZ, [UNION (Personal+Personal_Austritte)].OT, [UNION (Personal+Personal_Austritte)].STR, [UNION (Personal+Personal_Austritte)].ORT, [UNION (Personal+Personal_Austritte)].Anrede, Formulare.Ehrungen.TB_Jahr-Year([Jub_Dienstz AVR]) AS Berechnung1, Formulare.Ehrungen.TB_Jahr-Year([Jub_Dienstz DRW]) AS Berechnung2, [UNION (Personal+Personal_Austritte)].TNR
FROM [UNION (Personal+Personal_Austritte)]
WHERE (((Year([Jub_Dienstz AVR]))=[Formulare].[Ehrungen].[TB_Jahr25] Or (Year([Jub_Dienstz AVR]))=[Formulare].[Ehrungen].[TB_Jahr40] Or (Year([Jub_Dienstz AVR]))=[Formulare].[Ehrungen].[TB_Jahr50])) OR (((Year([Jub_Dienstz DRW]))=[Formulare].[Ehrungen].[TB_Jahr10] Or (Year([Jub_Dienstz DRW]))=[Formulare].[Ehrungen].[TB_Jahr15] Or (Year([Jub_Dienstz DRW]))=[Formulare].[Ehrungen].[TB_Jahr20] Or (Year([Jub_Dienstz DRW]))=[Formulare].[Ehrungen].[TB_Jahr30] Or (Year([Jub_Dienstz DRW]))=[Formulare].[Ehrungen].[TB_Jahr35] Or (Year([Jub_Dienstz DRW]))=[Formulare].[Ehrungen].[TB_Jahr45]));
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Ich würde euch bitten, den SQL-Code der Abfrage so umzubauen, dass das Ganze funktioniert. Ich brings einfach nicht hin! Das ganze übersteigt meinen Horizont!

Vielen Dank nochmals an Alle!

heddabach

Arne Dieckmann · 23. Juli 2007

Ich zeige dir nur einen Teil der Kriterien, wie sie aussehen müssen, sodass DAO damit umgehen kann.

Statt
Code:

(((Year([Jub_Dienstz AVR]))=[Formulare].[Ehrungen].[TB_Jahr25] Or (Year([Jub_Dienstz AVR]))=[Formulare].[Ehrungen].[TB_Jahr40] ...
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

schreibe:
Code:

(((Year([Jub_Dienstz AVR])) =eval("Forms![Ehrungen]![TB_Jahr25]")
OR (Year([Jub_Dienstz AVR])) =eval("Forms![Ehrungen]![TB_Jahr40]")
OR (Year([Jub_Dienstz AVR])) =eval("Forms![Ehrungen]![TB_Jahr50]")))
OR (((Year([Jub_Dienstz DRW]))=eval("Forms![Ehrungen]![TB_Jahr10]")
OR (Year([Jub_Dienstz DRW])) =eval("Forms![Ehrungen]![TB_Jahr15]")
OR (Year([Jub_Dienstz DRW])) =eval("Forms![Ehrungen]![TB_Jahr20]")
OR (Year([Jub_Dienstz DRW])) =eval("Forms![Ehrungen]![TB_Jahr30]")
OR (Year([Jub_Dienstz DRW])) =eval("Forms![Ehrungen]![TB_Jahr35]")
OR (Year([Jub_Dienstz DRW])) =eval("Forms![Ehrungen]![TB_Jahr45]")));
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Office: (Office 2003) Daten aus Access nach Excel direkt übergeben

Daten aus Access nach Excel direkt übergeben

Daten aus Access nach Excel direkt übergeben

Daten aus Access nach Excel direkt übergeben

Daten aus Access nach Excel direkt übergeben

Daten aus Access nach Excel direkt übergeben

Daten aus Access nach Excel direkt übergeben - Similar Threads - Daten Access Excel

Import Daten aus Access Abfrage klappt nicht

Access Tabelle mit Excel Daten updaten

Verwalten von Daten mit Access oder Excel

Verschieben von Daten aus Excel in Access

Import von Excel-Daten in Access-Tabelle

Excel Daten in Access automatisiert ablegen

Excel Daten in Access Tabelle importieren