schneller Datenimport
21.02.2019 20:21:34
Thomas
ich möchte gern eine Accesstabelle in Excel importieren.
Dazu habe ich das untenstehende Macro gefunden und angepasst ( soweit ich es konnte)
Dies läuft auch. Das einzige Problem ist das dieses Macro immer eine neue Exceldatei erstellt. Ich möchte aber das die Daten in das aktive Arbeitsblatt( von dem aus ich es aufrufe ) kopiert wird.
Kann mir jemand dabei helfen?
habt schon mal rechtvielen dank für eurer Interesse.
MFG Thomas
Private Sub CommandButton1_Click()
Dim xlsAnw As Object
Dim strSaveAsFilePath As String
Dim rs As DAO.Recordset
Dim db As Database
Dim targetrange As Excel.Range
Dim i As Integer
Dim sPath As String
sPath = IIf(Right$(ThisWorkbook.Path, 1) = "\", ThisWorkbook.Path, ThisWorkbook.Path & "\")
Set db = OpenDatabase(sPath & "Personenverwaltung.accdb")
'Set db = OpenDatabase("D:\Personenverwaltung (2)\Personenverwaltung\Personenverwaltung.accdb" _
)
Set rs = db.OpenRecordset("Personen")
'Set db = Application.CurrentDb
'Set rs = db.OpenRecordset("Salary History", dbOpenTable)
Set xlsAnw = CreateObject("Excel.Application")
With xlsAnw
.Visible = True
.WindowState = -4137 '-4143 = Normal, -4137 = Maximized; -4140 = Minimized
.Workbooks.Add
.Windows(1).Activate
'.Worksheets(3).Delete
'.Worksheets(2).Delete
.Worksheets(1).Activate
.Worksheets(1).Name = "Salary History"
.Worksheets("Salary History").Range("a1").Select
For i = 0 To rs.Fields.Count - 1
.Cells(1, i + 1) = rs.Fields(i).Name
Next i
.Range("A2").Select
.Selection.CopyFromRecordset rs
strSaveAsFilePath = xlsAnw.GetSaveAsFilename
xlsAnw.ActiveWorkbook.SaveAs strSaveAsFilePath
End With
Set xlsAnw = Nothing
End Sub