Export Access Tabelle in ein neues Excel Workbook

Forumthread: 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

AW: Export Access Tabelle in ein neues Excel Workb

21.06.2007 18:39:00

Anton

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

Beliebteste Forumthreads (12 Monate)

Export Access Tabelle in ein neues Excel Workbook

Forumthread: Export Access Tabelle in ein neues Excel Workbook

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread