Live-Forum - Die aktuellen Beiträge
Datum
Titel
20.04.2024 08:56:18
Textbox in Tabellenblatt ohne Bestätigung in Zelle eintragen
20.04.2024 07:57:54
Tablle fürs E-Auto - Preis wenn kürzer als 60 Min Ladezeit
20.04.2024 00:49:19
Excel Sheet in einen Excel Kalender einfügen
20.04.2024 00:08:11
In Ordner nur das Speichern von Dateien erlauben
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
880to884
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
880to884
880to884
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Export Access Tabelle in ein neues Excel Workbook

Export Access Tabelle in ein neues Excel Workbook
21.06.2007 17:53:07
Lars
Hallo,
Ich habe eine Access DB geöffnet. Nun möchte ich eine Tabelle in ein neues Excel Workbook exportieren. Gibt es hierzu einen Thread?
Vielen Dank!
Grüsse Lars

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Export Access Tabelle in ein neues Excel Workb
21.06.2007 18:39:00
Anton
Hallo Lars,
probier's damit:

Sub Datenbank_in_Tabelle_lesen()
Dim wrkDefault  'As Workspace
Dim dbsNew   ' As DATABASE
Dim prpLoop   ' As Property
Dim test
strDatenbank = Application.GetOpenFilename("MS-Access Datenbank (*.mdb),*.mdb", , _  
"Pfad zur Auslieferungsdatenbank ändern")
If InStr(1, LCase(strDatenbank), "fals", vbTextCompare) Then Exit Sub      
Set test = CreateObject("DAO.DBEngine.36")  
' Standardarbeitsbereich bestimmen.
Set wrkDefault = test.Workspaces(0)
'msgbox wrkDefault.username
On Error Resume Next    
Set dbsNew = wrkDefault.openDatabase(strDatenbank, 1, 0, ";pwd=")  
If Err.Number = 3031 Then  
  dbsNew.Close  
  Err.Clear
  passwort = InputBox("Passwort eingeben")  
  Set dbsNew = wrkDefault.openDatabase(strDatenbank, 1, 0, ";pwd=" & passwort)  
  If Err.Number = 3031 Then  
    dbsNew.Close  
    Err.Clear
    MsgBox "Falsches Passwort!"
    Exit Sub  
  End If  
End If  
If Err.Number = 3356 Then  
  MsgBox Err.Description
  Exit Sub  
End If  
Application.Workbooks.Add
Dim neuesBlatt As Worksheet  
For i = 0 To dbsNew.TableDefs.Count - 1  
'MsgBox LCase(dbsNew.TableDefs(i).Name)
'MsgBox InStr(1, LCase(dbsNew.TableDefs(i).Name), "msys", vbTextCompare)
  If InStr(1, LCase(dbsNew.TableDefs(i).Name), "msys", vbTextCompare) <> 1 Then    
    Set neuesBlatt = ActiveWorkbook.Worksheets.Add
    With neuesBlatt
      k = 1
      .Name = dbsNew.TableDefs(i).Name
      .Rows(1).Font.Bold = True
'      .Cells.NumberFormat = "@"
      Set tdfNew = dbsNew.TableDefs(i)  
        For j = 0 To tdfNew.Fields.Count - 1  
          .Cells(k, j + 1).Value = tdfNew.Fields(j).Name
            Debug.Print tdfNew.Fields(j).Name  
        Next
        Set rstDatensaetze = dbsNew.OpenRecordset(tdfNew.Name, 2)  
        Do While Not rstDatensaetze.EOF  
          k = k + 1
          For n = 0 To rstDatensaetze.Fields.Count - 1  
            .Cells(k, n + 1).Value = rstDatensaetze.Fields(n)
          Next
          rstDatensaetze.MoveNext
        Loop
        rstDatensaetze.Close
        .Columns.AutoFit
    End With  
  End If  
Next
dbsNew.Close  
End Sub  

mfg Anton
Anzeige

Links zu Excel-Dialogen

InputBox

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige