Access nach Excell exportieren

[karomue]

Hallo Michael,

die DB war ja mini. brach aber immer mit Fehler ab. Export betr. wirklich nur eine Tabelle.

Makroaufzeichnung aus Excel? Wie geht so was? "Breite doch mal den roten Faden" aus, vielleicht kann ich dazulernen. Makroaufzeichnung an sich ist bekannt, nur "was" und "wie"?

Ich möchte ungern den ganzen Codeblock hier einfügen, das würde m.A. nach doch die Geduld des Forums sprengen.

[Zwergel]

Hi Charly,

also Upload von DBs geht derzeitig nicht, dazu fehlen die Definitionen in den Foreneinstellungen, Hintertür wäre DB umbennen als Zip, oder eben als Zip speichern und dann hochladen.

Aufzeichnen in Excel:

Excel starten, Entwicklungstool öffnen (Menü), falls nicht vorhanden in den Exceloptionen freischalten
Dann Macroaufzeichnung starten.

Danach alle Schritte wie bei einem Import externer Daten ausführen. Also Menü Daten, Aus Access und dann weiter. Am Ende wieder Entwicklungsumgebung öffen, Makroaufzeichnung beenden . Exceldatei mit Code speichern.

Code ansehen und ggf. da wo variable Daten nötig sind, mit Hilfe den Code anpassen.

[karomue]

Seltsam. Der Hochladeversuch bricht mit Fehler ab. Die Datei ist - trotzdem nur 1 Zeile - 8GB groß und hat die Endung *.accdb - Access365 bzw. 2016.

Irgendwas passt hier nicht (?).

[Zwergel]

Wie bereits geschrieben, geht derzeitig nicht. Habe Admins gebeten, zusätzliche Typen frei zu geben. Also etwas Geduld oder eben über den Umweg Zip.

Würde aber mal den Excelweg gehen und schaun was da geht.

[karomue]

Hi Charly,

also Upload von DBs geht derzeitig nicht, dazu fehlen die Definitionen in den Foreneinstellungen, Hintertür wäre DB umbennen als Zip, oder eben als Zip speichern und dann hochladen.

Aufzeichnen in Excel:

Excel starten, Entwicklungstool öffnen (Menü), falls nicht vorhanden in den Exceloptionen freischalten
Dann Macroaufzeichnung starten.

Danach alle Schritte wie bei einem Import externer Daten ausführen. Also Menü Daten, Aus Access und dann weiter. Am Ende wieder Entwicklungsumgebung öffen, Makroaufzeichnung beenden . Exceldatei mit Code speichern.

Code ansehen und ggf. da wo variable Daten nötig sind, mit Hilfe den Code anpassen.

Schau ich mir morgen an. Danke. Jetzt steht Abendessen auf dem Programm und danach muss ich mich dringend hinlegen. :@ Mit Import sollte ich doch noch zurechtkommen. Kann aber etwas dauern, bis ich morgen dazukomme. Der Tag ist schon wieder reichlich gefüllt.

[Rabe]

Hi,

Wie bereits geschrieben, geht derzeitig nicht. Habe Admins gebeten, zusätzliche Typen frei zu geben. Also etwas Geduld oder eben über den Umweg Zip.

Würde aber mal den Excelweg gehen und schaun was da geht.

ich mache es heute abend nach dem Schwimmen. Welche Datei-Typen/-Erweiterungen sind denn wünschenswert?

[Rabe]

Seltsam. Der Hochladeversuch bricht mit Fehler ab. Die Datei ist - trotzdem nur 1 Zeile - 8GB groß und hat die Endung *.accdb - Access365 bzw. 2016.

Irgendwas passt hier nicht (?).

Aber auch wenn der Upload freigegeben ist, werde ich eine 8GB große Datei nicht zum upload freigeben!
Das wirst DU auch nicht hochladen wollen und es wird sich auch niemand runterladen!

[schauan]

Hallöchen,
ja, bei 8 GB müssen wir uns etwas anderes einfallen lassen. Sind da Bilder drin oder warum ist die so groß?
Eventuell hast Du eine Dropbox-Account mit ausreichend Speicher?
Alternativ könnte ich Dir was freigeben, wo Du an anderer Stelle was hochladen kannst und ich kann das freigeben. Hoffe ich, hab's noch nicht probiert.

[schauan]

Hallo Charly,

accdb gehen jetzt, aber nur 2 MB. Meintest Du wirklich 8 GB oder sind es 8 MB? Früher gab es mal eine Option "Datenbank komprimieren", gibt es die eventuell noch?

[BoskoBiati]

Hallo,

ich habe hier ein Makro, welches eine Datei nach Excel exportiert. Alles, was  mit ds! anfängt, beinhaltet die Felder, die in der Tabelle vorhanden sind. tab1 sind nur Dummy-Namen:


Sub ExcelExport()


    Dim xlApp As Object, xlBook As Object, xlSheet As Object, xlBook2 As Object, xlSheet2 As Object, xlsheet1 As Object
    Const FullExcelDatName = "D:\Dateipfad + Name.xlsm"
    Const FullExcelDatName2 = "D:\Dateipfad + Name Sicherung.xlsm"
    Const ExcelTabName1 = "Exctab1"
    Const ExcelTabName2 = "Exctab2"
    Const ExcelTabName3 = "Exctab3"
    Const ExcelTabName4 = "Tab1"
    Const ExcelTabName5 = "Tab5"
    Const AccessTabName1 = "tblTab1"
    Const AccessTabName2 = "tblTab2"
    Const AccessTabName3 = "tblTab3"
    Const xlUp = -4162
    Const xlByRows = 1
    Const xlPrevious = 2
    Dim rng As Range
    Dim loZeile As Long
    Dim AktExcelZeile As Long
    Dim AktDb As DAO.Database, ds As DAO.Recordset
    Dim LastRec As Long
    Set AktDb = CurrentDb
   ' Excel datei öffnen ohne Fehlerbehandlung
    On Error Resume Next
    Set xlApp = GetObject(, "Excel.Application")
    If xlApp Is Nothing Then
        Set xlApp = CreateObject("Excel.Application")
    End If
    xlApp.Visible = True
    On Error GoTo 0
    Set xlBook = xlApp.Workbooks.Open(FullExcelDatName)
    Set xlSheet = xlBook.Sheets(ExcelTabName1)
    Set xlsheet1 = xlBook.Sheets(ExcelTabName4)
    Set xlZelle = xlSheet.Cells.Find("*", , , , xlByRows, xlPrevious)
    If Not xlZelle Is Nothing Then
        AktExcelZeile = xlZelle.Row + 1
    End If
    LastRec = AktExcelZeile - 2
    Set ds = AktDb.OpenRecordset(AccessTabName1)
    ds.MoveFirst
    ds.Move (LastRec)
    ds.MoveLast
    loZeile = ds!LFDNR
  
    If loZeile > LastRec Then
    ds.MoveFirst
    ds.Move (LastRec)
    Do Until ds.EOF
        xlSheet.Cells(AktExcelZeile, 1).Value = ds!LFDNR
        xlsheet1.Cells(AktExcelZeile, 1).Value = ds!LFDNR
        xlSheet.Cells(AktExcelZeile, 2).Value = ds!Kennziffer
        xlSheet.Cells(AktExcelZeile, 3).Value = ds!MANr
        xlSheet.Cells(AktExcelZeile, 4).Value = ds!EINGDATUM
        xlSheet.Cells(AktExcelZeile, 5).Value = ds!KundenID
        xlSheet.Cells(AktExcelZeile, 6).Value = ds!ArtNr
        AktExcelZeile = AktExcelZeile + 1
        ds.MoveNext
    Loop
    
    Set xlSheet = Nothing
    Set xlSheet = xlBook.Sheets(ExcelTabName2)
    Set xlZelle = xlSheet.Cells.Find("*", , , , xlByRows, xlPrevious)
    If Not xlZelle Is Nothing Then
        AktExcelZeile = xlZelle.Row + 1
    End If
    Set ds = AktDb.OpenRecordset(AccessTabName2)
    ds.MoveLast
    LastRec = ds!KundenID
    ds.MoveFirst
    loZeile = ds.RecordCount
    If loZeile > AktExcelZeile - 2 Then
    ds.Move (AktExcelZeile - 2)
    Do Until ds.EOF
        xlSheet.Cells(AktExcelZeile, 1).Value = ds!KundenID
        xlSheet.Cells(AktExcelZeile, 2).Value = ds!KundeName
        xlSheet.Cells(AktExcelZeile, 3).Value = ds!KundeStr
        xlSheet.Cells(AktExcelZeile, 4).Value = ds!KundeLand
        xlSheet.Cells(AktExcelZeile, 5).Value = ds!KundePLZ
        xlSheet.Cells(AktExcelZeile, 6).Value = ds!KundeOrt
        AktExcelZeile = AktExcelZeile + 1
        ds.MoveNext
    Loop
    End If
    
    Set xlSheet = Nothing
    Set xlSheet = xlBook.Sheets(ExcelTabName3)
    Set xlZelle = xlSheet.Cells.Find("*", , , , xlByRows, xlPrevious)
    If Not xlZelle Is Nothing Then
        AktExcelZeile = xlZelle.Row + 1
    End If
    Set ds = AktDb.OpenRecordset(AccessTabName3)
    ds.MoveLast
    LastRec = ds!ArtNr
    ds.MoveFirst
    loZeile = ds.RecordCount
    If loZeile > AktExcelZeile Then
    ds.Move (AktExcelZeile - 2)
    Do Until ds.EOF
        xlSheet.Cells(AktExcelZeile, 1).Value = ds!ArtNr
        xlSheet.Cells(AktExcelZeile, 2).Value = ds!ArtName
        AktExcelZeile = AktExcelZeile + 1
        ds.MoveNext
    Loop
    End If
    
    Set xlSheet = Nothing
    Set xlSheet2 = Nothing
    
    
'Excel speichern
    xlBook.Save
    If Dir(FullExcelDatName2) <> "" Then Kill (FullExcelDatName2)
    Set rng = xlBook.Sheets("Tab1").Range("A1:T2000")
    rng.Copy
    rng.PasteSpecial (xlPasteValuesAndNumberFormats)
    xlApp.DisplayAlerts = False
    For loZeile = xlBook.Sheets.Count To 1 Step -1
    If xlBook.Sheets(loZeile).Name <> "Tab1" Then xlBook.Sheets(loZeile).Delete
    Next
    xlApp.DisplayAlerts = True
    xlBook.SaveAs (FullExcelDatName2)
End If
    xlBook.Close
    Set xlSheet = Nothing
    Set xlBook = Nothing
    
    
End Sub