Datenüberleitung von Access nach Excel

Flyingeagle2 · 15. Juni 2008

Hallo Leute!

Ich hoffe ihr könnt mir helfen! Würde gerne Daten aus einer Access Tabelle nach Excel überleiten... Der user soll sich via einem Access Formular selbst aussuchen können, welche Daten nach Excel übergeleitet werden. Habe jetzt folgenden code programmiert, und bekomme immer wieder Fehler... weiß aber nicht wo dieser liegt:

Dim rs As New ADODB.Recordset
Set rs = New ADODB.Recordset
rs.Open liste, CurrentProject.Connection

Dim ExcelSheet As Object
Set ExcelSheet = GetObject("C:\vb\test.xls")

ExcelSheet.Application.Visible = True

ExcelSheet.Application.Cells(3, 1).Value = sp1
If sp2 > "" Then
ExcelSheet.Application.Cells(3, 2).Value = sp2
End If

If sp3 > "" Then
ExcelSheet.Application.Cells(3, 3).Value = sp3
End If

Do Until rs.EOF
lnz = 1
If K_Bauleiternr = -1 Then
ExcelSheet.Application.Cells(lnr, 1).Value = rs.Fields("Zuname") & " " & rs.Fields("Vorname")
lnz = lnz + 1
End If

If K_Jahr = -1 Then
ExcelSheet.Application.Cells(lnr, lnz).Value = rs!Jahr
lnz = lnz + 1
End If

If K_Wohnungsanzahl = -1 Then
ExcelSheet.Application.Cells(lnr, lnz).Value = rs!Wohnungsanzahl
lnz = lnz + 1
End If

If K_Nutzungsfläche = -1 Then
ExcelSheet.Application.Cells(lnr, lnz).Value = rs!Nutzungsfläche
lnz = lnz + 1
End If

lnr = lnr + 1
rs.MoveNext
Loop

ExcelSheet.Application.Cells.SELECT
ExcelSheet.Application.Cells.EntireColumn.AutoFit

ExcelSheet.Application.Cells(1, 1).Value = "Statistische Auswertung Bauvorhaben:"

Ich hoffe ihr könnt mir irgendwie helfen!!

mit freundlichen grüßen

Flyingeagle

Alex F. · 15. Juni 2008

Also erstens wäre es gut welchen Fehler du bekommst.

´Zweitens arbeitest du mit einem Recordset welches nicht genauer spezifiziert ist.

Grüsse bb

Flyingeagle2 · 16. Juni 2008

Fehlermeldung :Laufzeitfehler 1004 Anwendungs oder objektdefinierter Fehler

bei ExcelSheet.Application.Cells(3, 1).Value = sp1

Alex F. · 16. Juni 2008

sp1 ist eine Variable ? ein Objekt ? oder was ?

Wenn du sp1 deklarierst oder in " " einfasst ist der Fehler weg.

Dein zweites Problem bleibt allerdings noch.

Grüsse bb

PS: für Code Schnipsel haben wir Tags wie [code=vb][/code] oder [CODE][/CODE] dann ist der Code lesbarer

Flyingeagle2 · 16. Juni 2008

ok ich stell mal den ganzen code rein... vl. hat jemand zeit den durchzugehen, dann ists vl. überschaubarer...

Visual Basic:

Private Sub btnstart_Click()

    Dim suche
    
  Dim liste
liste = " "
'                             Definition Überschriften für Spalten in Excel für max. Spaltenanzahl
Dim sp1
Dim sp2
Dim sp3
Dim sp4
Dim sp5
Dim sp6
Dim sp7
Dim sp8
Dim sp9
Dim sp10

Dim sp40                      'letze Spalte, besonders
'                              Definition Hilfsvariablen
Dim lz1
Dim lz2
Dim lzp
Dim lnz
Dim bs
Dim liste2


'                              KONTROLLE-ANLAGE Verzeichnis
'                              KONTROLLE-Löschung Bericht

'                                  ERSTELLUNG ABFRAGE

If K_Bauleiternr = -1 Then
    liste = liste & "Bauvorhaben.Bauleiternr"
End If

If K_Jahr = -1 Then
    If liste <> "Select " Then
        liste = liste & ", Bauvorhaben.Jahr"
    Else
        liste = liste & "Bauvorhaben.Jahr"
    End If
End If

If K_Wohnungsanzahl = -1 Then
    If liste <> "Select " Then
        liste = liste & ", Bauvorhaben.Wohnungsanzahl"
    Else
        liste = liste & "Bauvorhaben.Wohnungsanzahl"
    End If
End If

If K_Nutzungsfläche = -1 Then
    If liste <> "Select " Then
        liste = liste & ", Bauvorhaben.Nutzungsfläche"
    Else
        liste = liste & "Bauvorhaben.Nutzungsfläche"
    End If
End If

If K_Bautyp = -1 Then
    If liste <> "Select " Then
        liste = liste & ", Bauvorhaben.Bautyp"
    Else
        liste = liste & "Bauvorhaben.Bautyp"
    End If
End If

If K_Rechtsform = -1 Then
    If liste <> "Select " Then
        liste = liste & ", Bauvorhaben.Rechtsform"
    Else
        liste = liste & "Bauvorhaben.Rechtsform"
    End If
End If

If K_Ort = -1 Then
    If liste <> "Select " Then
        liste = liste & ", Bauvorhaben.Ort"
    Else
        liste = liste & "Bauvorhaben.Ort"
    End If
End If

If K_Solaranlagen = -1 Then
    If liste <> "Select " Then
        liste = liste & ", Bauvorhaben.Solaranlagen"
    Else
        liste = liste & "Bauvorhaben.Solaranlagen"
    End If
End If

If K_Mandant = -1 Then
    If liste <> "Select " Then
        liste = liste & ", Bauvorhaben.Mandant"
    Else
        liste = liste & "Bauvorhaben.Mandant"
    End If
End If

If K_Baukosten = -1 Then
    If liste <> "Select " Then
        liste = liste & ", Bauvorhaben.Baukosten"
    Else
        liste = liste & "Bauvorhaben.Baukosten"
    End If
End If

Debug.Print liste
'                          AUSLESEN FELDBEZ. AUS ABFRAGE

liste = liste & " "

lz1 = InStr(1, liste, ".")
lz2 = InStr(lz1 + 1, liste, " ")
lzp = InStr(1, liste, ".")
sp1 = Mid(liste, lzp + 1, lz2 - lzp - 2)
If Len(liste) = lz2 Then sp1 = Mid(liste, lzp + 1, lz2 - lzp - 1)
If Len(liste) = lz2 Then GoTo ende

lz1 = lz2
lz2 = InStr(lz1 + 1, liste, " ")
lzp = InStr(lz1, liste, ".")
sp2 = Mid(liste, lzp + 1, lz2 - lzp - 2)
If Len(liste) = lz2 Then sp2 = Mid(liste, lzp + 1, lz2 - lzp - 1)
If Len(liste) = lz2 Then GoTo ende

lz1 = lz2
lz2 = InStr(lz1 + 1, liste, " ")
lzp = InStr(lz1, liste, ".")
sp3 = Mid(liste, lzp + 1, lz2 - lzp - 2)
If Len(liste) = lz2 Then sp3 = Mid(liste, lzp + 1, lz2 - lzp - 1)
If Len(liste) = lz2 Then GoTo ende

lz1 = lz2
lz2 = InStr(lz1 + 1, liste, " ")
lzp = InStr(lz1, liste, ".")
sp4 = Mid(liste, lzp + 1, lz2 - lzp - 2)
If Len(liste) = lz2 Then sp4 = Mid(liste, lzp + 1, lz2 - lzp - 1)
If Len(liste) = lz2 Then GoTo ende

lz1 = lz2
lz2 = InStr(lz1 + 1, liste, " ")
lzp = InStr(lz1, liste, ".")
sp5 = Mid(liste, lzp + 1, lz2 - lzp - 2)
If Len(liste) = lz2 Then sp5 = Mid(liste, lzp + 1, lz2 - lzp - 1)
If Len(liste) = lz2 Then GoTo ende

lz1 = lz2
lz2 = InStr(lz1 + 1, liste, " ")
lzp = InStr(lz1, liste, ".")
sp6 = Mid(liste, lzp + 1, lz2 - lzp - 2)
If Len(liste) = lz2 Then sp6 = Mid(liste, lzp + 1, lz2 - lzp - 1)
If Len(liste) = lz2 Then GoTo ende

lz1 = lz2
lz2 = InStr(lz1 + 1, liste, " ")
lzp = InStr(lz1, liste, ".")
sp7 = Mid(liste, lzp + 1, lz2 - lzp - 2)
If Len(liste) = lz2 Then sp7 = Mid(liste, lzp + 1, lz2 - lzp - 1)
If Len(liste) = lz2 Then GoTo ende

lz1 = lz2
lz2 = InStr(lz1 + 1, liste, " ")
lzp = InStr(lz1, liste, ".")
sp8 = Mid(liste, lzp + 1, lz2 - lzp - 2)
If Len(liste) = lz2 Then sp8 = Mid(liste, lzp + 1, lz2 - lzp - 1)
If Len(liste) = lz2 Then GoTo ende

lz1 = lz2
lz2 = InStr(lz1 + 1, liste, " ")
lzp = InStr(lz1, liste, ".")
sp9 = Mid(liste, lzp + 1, lz2 - lzp - 2)
If Len(liste) = lz2 Then sp9 = Mid(liste, lzp + 1, lz2 - lzp - 1)
If Len(liste) = lz2 Then GoTo ende

lz1 = lz2
lz2 = InStr(lz1 + 1, liste, " ")
lzp = InStr(lz1, liste, ".")
sp10 = Mid(liste, lzp + 1, lz2 - lzp - 2)
If Len(liste) = lz2 Then sp10 = Mid(liste, lzp + 1, lz2 - lzp - 1)
If Len(liste) = lz2 Then GoTo ende
ende:

Dim lnr
lnr = 4                     'ZEILE FÜR Überleitung Daten Excel


'                            Ergänzung ABFRAGE mit Selektionskriterien

If blvon <> 0 Then
    suche = "Bauvorhaben.Bauleiternr = " & blvon
End If

If Bautyp <> 0 Then
    If suche > "" Then
    suche = suche & " AND Bauvorhaben.Bautyp = " & Chr(34) & Bautyp & Chr(34)
    Else
        suche = suche & " Bauvorhaben.Bautyp = " & Chr(34) & Bautyp & Chr(34)
    End If
End If

If Rechtsform <> 0 Then
    If suche > "" Then
    suche = suche & " AND Bauvorhaben.Rechtsform = " & Chr(34) & Rechtsform & Chr(34)
    Else
        suche = suche & " Bauvorhaben.Rechtsform = " & Chr(34) & Rechtsform & Chr(34)
    End If
End If

If Ort <> 0 Then
    If suche > "" Then
    suche = suche & " AND Bauvorhaben.Ort = " & Chr(34) & Ort & Chr(34)
    Else
        suche = suche & " Bauvorhaben.Ort = " & Chr(34) & Ort & Chr(34)
    End If
End If

If Solaranlagen <> 0 Then
    If suche > "" Then
    suche = suche & " AND Bauvorhaben.Solaranlagen = " & Chr(34) & Solaranlagen & Chr(34)
    Else
        suche = suche & " Bauvorhaben.Solaranlagen = " & Chr(34) & Solaranlagen & Chr(34)
    End If
End If

If Mandant <> 0 Then
    If suche > "" Then
    suche = suche & " AND Bauvorhaben.Mandant = " & Chr(34) & Mandant & Chr(34)
    Else
        suche = suche & " Bauvorhaben.Mandant = " & Chr(34) & Mandant & Chr(34)
    End If
End If
'                            Block Beginn für weitere Felder kopieren
If jahrbis <> 0 Then
    If suche > "" Then
    
        suche = suche & " AND Bauvorhaben.Jahr >= " & jahrvon & " AND Bauvorhaben.Jahr <= " & jahrbis
    Else
        suche = "Bauvorhaben.Jahr >= " & jahrvon & " AND Bauvorhaben.Jahr <= " & jahrbis
    End If
End If

If wohnungsanzahlbis <> 0 Then
    If suche > "" Then
        suche = suche & " AND Bauvorhaben.Wohnungsanzahl >= " & wohnungsanzahlvon & " AND Bauvorhaben.Wohnungsanzahl <= " & wohnungsanzahlbis
    Else
        suche = "Bauvorhaben.Wohnungsanzahl >= " & wohnungsanzahlvon & " AND Bauvorhaben.Wohnungsanzahl <= " & wohnungsanzahlbis
    End If
End If

If baukostenbis <> 0 Then
    If suche > "" Then
        suche = suche & " AND Bauvorhaben.Baukosten >= " & baukostenvon & " AND Bauvorhaben.Baukosten <= " & baukostenbis
    Else
        suche = "Bauvorhaben.Baukosten >= " & baukostenvon & " AND Bauvorhaben.Baukosten <= " & baukostenbis
    End If
End If

If nutzungsflächebis <> 0 Then
    If suche > "" Then
        suche = suche & " AND Bauvorhaben.nutzungsfläche >= " & nutzungsflächevon & " AND Bauvorhaben.nutzungsfläche <= " & nutzungsflächebis
    Else
        suche = "Bauvorhaben.nutzungsfläche >= " & nutzungsflächevon & " AND Bauvorhaben.nutzungsfläche <= " & nutzungsflächebis
    End If
End If




'                            Block Ende für weitere Felder kopieren

liste2 = liste
liste = "SELECT Bauleiter.Bauleiternr, Bauleiter.Zuname, Bauleiter.Vorname," & liste2
liste = liste & "FROM Bauleiter INNER JOIN Bauvorhaben ON Bauleiter.Bauleiternr = Bauvorhaben.Bauleiternr"


'SELECT Bauleiter.Bauleiternr, Bauleiter.Zuname, Bauleiter.Vorname, Bauvorhaben.Objnr, Bauvorhaben.Bauvorhaben, Bauvorhaben.Bauleiternr, Bauvorhaben.Baukosten
'FROM Bauleiter INNER JOIN Bauvorhaben ON Bauleiter.Bauleiternr = Bauvorhaben.Bauleiternr
'WHERE (((Bauleiter.Bauleiternr)=2));

'                           Ergänzung Abfrage mit WHERE-Optionen
If suche > "" Then
liste = liste & " WHERE " & suche
End If

liste = liste & " Order by Bauvorhaben.Bauleiternr"
Debug.Print liste

'                           Überleitung der Daten in Excel

Dim rs As New ADODB.Recordset
Set rs = New ADODB.Recordset
rs.Open liste, CurrentProject.Connection

Dim ExcelSheet As Object
Set ExcelSheet = GetObject("C:\vb\test.xls", "Excel.Sheet")

ExcelSheet.Application.Visible = True



ExcelSheet.Application.Cells(3, 1).Value = sp1
If sp2 > "" Then
    ExcelSheet.Application.Cells(3, 2).Value = sp2
End If

If sp3 > "" Then
    ExcelSheet.Application.Cells(3, 3).Value = sp3
End If

If sp4 > "" Then
    ExcelSheet.Application.Cells(3, 4).Value = sp4
End If

If sp5 > "" Then
    ExcelSheet.Application.Cells(3, 5).Value = sp5
End If

If sp6 > "" Then
    ExcelSheet.Application.Cells(3, 6).Value = sp6
End If

If sp7 > "" Then
    ExcelSheet.Application.Cells(3, 7).Value = sp7
End If

If sp8 > "" Then
    ExcelSheet.Application.Cells(3, 8).Value = sp8
End If

If sp9 > "" Then
    ExcelSheet.Application.Cells(3, 9).Value = sp9
End If

If sp10 > "" Then
    ExcelSheet.Application.Cells(3, 10).Value = sp10
End If

If sp40 > "" Then
    ExcelSheet.Application.Cells(3, 11).Value = sp40    ' neue Oben einfügen , Zellbezug ändern
End If



Do Until rs.EOF
    lnz = 1
    If K_Bauleiternr = -1 Then
        ExcelSheet.Application.Cells(lnr, 1).Value = rs.Fields("Zuname") & " " & rs.Fields("Vorname")
        lnz = lnz + 1
    End If
    
    If K_Jahr = -1 Then
        ExcelSheet.Application.Cells(lnr, lnz).Value = rs!Jahr
        lnz = lnz + 1
    End If
    
    If K_Wohnungsanzahl = -1 Then
        ExcelSheet.Application.Cells(lnr, lnz).Value = rs!Wohnungsanzahl
        lnz = lnz + 1
    End If
    
    If K_Nutzungsfläche = -1 Then
        ExcelSheet.Application.Cells(lnr, lnz).Value = rs!Nutzungsfläche
        lnz = lnz + 1
    End If

    If K_Bautyp = -1 Then
        ExcelSheet.Application.Cells(lnr, lnz).Value = rs!Bautyp
        lnz = lnz + 1
    End If
    
    If K_Rechtsform = -1 Then
        ExcelSheet.Application.Cells(lnr, lnz).Value = rs!Rechtsform
        lnz = lnz + 1
    End If
    
    If K_Ort = -1 Then
        ExcelSheet.Application.Cells(lnr, lnz).Value = rs!Ort
        lnz = lnz + 1
    End If

    If K_Solaranlagen = -1 Then
        ExcelSheet.Application.Cells(lnr, lnz).Value = rs!Solaranlagen
        lnz = lnz + 1
    End If

    If K_Mandant = -1 Then
        ExcelSheet.Application.Cells(lnr, lnz).Value = rs!Mandant
        lnz = lnz + 1
    End If
    
    If K_Baukosten = -1 Then
        ExcelSheet.Application.Cells(lnr, lnz).Value = rs!Baukosten
        lnz = lnz + 1
    End If
    
    

    lnr = lnr + 1
    rs.MoveNext
Loop

ExcelSheet.Application.Cells.SELECT
ExcelSheet.Application.Cells.EntireColumn.AutoFit

ExcelSheet.Application.Cells(1, 1).Value = "Statistische Auswertung Bauvorhaben:"


' Speichern der Tabelle unter C:\test.xls



' Schließen von Excel mit der Quit-Methode des
' Application-Objekts.
ExcelSheet.Application.Quit
' Freigeben der Objektvariable.
Set ExcelSheet = Nothing


On Error GoTo Err_btnstart_Click

    

  
    Call Shell(ExcelSheet, 1)

Exit_btnstart_Click:
    Exit Sub

Err_btnstart_Click:
    MsgBox Err.Description
    Resume Exit_btnstart_Click

        
    ' DoCmd.OpenReport "Test", acViewPreview, , suche

Fehler kommt wie gesagt:

Laufzeitfehler 1004 Anwendungs oder objektdefinierter Fehler

bei "ExcelSheet.Application.Cells(3, 1).Value = sp1"

Alex F. · 16. Juni 2008

Wie man sieht hast du sp1 als variant deklariert.

zweitens greifst du auf ein seltsames objekt zu

Versuchs mal mit

ActiveWorkbook.Sheets("Tabelle1").cells(3,1).value = irgendwas

ist mit sicherheit falsch

Grüsse bb
ExcelSheet.Application.Cells(3, 1).Value = sp1

Flyingeagle2 · 17. Juni 2008

hm... ist dasselbe in blau... Laufzeitfehler 424 Objekt erforderlich... arrr danke trotzdem für die mühe!

Datenüberleitung von Access nach Excel

Flyingeagle2

Grünschnabel

Alex F.

Erfahrenes Mitglied

Flyingeagle2

Grünschnabel

Alex F.

Erfahrenes Mitglied

Flyingeagle2

Grünschnabel

Alex F.

Erfahrenes Mitglied

Flyingeagle2

Grünschnabel

Neue Beiträge