Import aus Excel mittels VBA

[pkoenig]

Hallo.

Probleme dieser Art gibt es zwar zu genüge aber schlau werde ich bisher aus keinem.
Ich habe eine Datenbank die, großatiger Hilfe sei Dank, eigentlich prima funktioniert.

Ich habe nun einen Button in einem Formular angelegt. Durch Klicken soll sich ein Fenster öffnen, dass mich auf meinem laufwerk eine Excel-Datei auswählen lässt. Der Ort dieser Datei ist nämlich nicht standartisierbar.

Die Datei selbst hat immer den selben Aufbau. Ziel ist es, einen einzigen Datensatz aus Tabelle 2 (A1:AK2) in meine Tabelle "Messaufträge" zu importieren.
Das sollte ja über DoCmd.TransferSpreadsheet irgendwie kalppen aber ich bekomm es nicht hin.

Könnt ihr mir da weiter helfen?

Grüße


pkoenig

[DF6GL]

Hallo,

einfach in die VBA-Hilfe zu Transferspreadsheet schauen,  dort ist der "Bereich"-Parameter beschrieben.

[pkoenig]

Danke für die schnelle Antwort.
Die Idee hatte ich bereits schon. Wenn ich meinen Code ausführe, zeigt mir Acc eine Fehlermeldung aus.

Wie müsste denn der Code für so etwas lauten?

[DF6GL]

Hallo,

sinnvoll wäre den Code und die Fehlermeldung zu posten...

[pkoenig]

Mein Code wäre etwa dieser :

Private Sub Befehl124_Click()
On Error GoTo Error
Dim A As Variant
Dim Pfad As String
//hier müsste dann ein Fenster zur Dateiauswahl/Navigation geöffnet werden, nach dem Motto://
A = DateiOeffnen("C:\", "Bitte Stammdaten-Excel-Tabelle auswählen:", "Exceltabelle")
If IsNull(A) Or A = "" Then
Else: Pfad = A
End If
DoCmd.TransferSpreadsheet acImport, 8, "import_test", Pfad, True, "A2:AK2"
End Sub

Ich weiß nicht ob die herangehensweise korrekt ist. Und wie ich den Teil mit dem Fenster angehen soll, da habe ich mittlerweile gar keine Ahnung mehr.

Grüße

[DF6GL]

Hallo,

die Herangehensweise ist schon ok, Du musst Dir halt noch die Funktion "Dateioeffnen" besorgen.


Private Sub Befehl124_Click()
On Error GoTo MyErr

Dim Pfad As String
Pfad = DateiOeffnen("C:\", "Bitte Stammdaten-Excel-Tabelle auswählen:")  'Funktion besorgen und für "Excel" anpassen z. B.: http://www.access-paradies.de/tipps/datei_oeffnen__speichern_dialog.php

If Pfad <>"" Then
DoCmd.TransferSpreadsheet acImport, 8, "import_test", Pfad, True, "Tabelle2!A2:AK2"
End If
ExitSub:
Exit Sub

MyErr:
Msgbox Err.Number & ": " & Err.Description
Resume ExitSub
End Sub

End Sub

[pkoenig]

Hallo.
Jetzt zeigt Access an, dass nach EndFunktion, EndSub, ... nur kommentare stehen dürfen.

Mein Code ist jetzt ellenlang und sieht so aus:

Code [Auswählen] Erweitern

Private Sub cmd_read_Click()

On Error GoTo MyErr

Dim Path As String

Option Compare Database
Option Explicit

Type DateiDialogStruktur
       lStructSize As Long
       hwndOwner As Long
       hInstance As Long
       lpstrFilter As String
       lpstrCustomFilter As String
       nMaxCustFilter As Long
       nFilterIndex As Long
       lpstrFile As String
       nMaxFile As Long
       lpstrFileTitle As String
       nMaxFileTitle As Long
       lpstrInitialDir As String
       lpstrTitle As String
       flags As Long
       nFileOffset As Integer
       nFileExtension As Integer
       lpstrDefExt As String
       lCustData As Long
       lpfnHook As Long
       lpTemplateName As String
End Type

Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" _
(DateiDialogStruktur As DateiDialogStruktur) As Long
Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" _
(DateiDialogStruktur As DateiDialogStruktur) As Long

Public Const OFN_ALLOWMULTISELECT = &H200
Public Const OFN_CREATEPROMPT = &H2000
Public Const OFN_ENABLEHOOK = &H20
Public Const OFN_ENABLETEMPLATE = &H40
Public Const OFN_ENABLETEMPLATEHANDLE = &H80
Public Const OFN_EXPLORER = &H80000
Public Const OFN_EXTENSIONDIFFERENT = &H400
Public Const OFN_FILEMUSTEXIST = &H1000
Public Const OFN_HIDEREADONLY = &H4
Public Const OFN_LONGNAMES = &H200000
Public Const OFN_NOCHANGEDIR = &H8
Public Const OFN_NODEREFERENCELINKS = &H100000
Public Const OFN_NOLONGNAMES = &H40000
Public Const OFN_NONETWORKBUTTON = &H20000
Public Const OFN_NOREADONLYRETURN = &H8000
Public Const OFN_NOTESTFILECREATE = &H10000
Public Const OFN_NOVALIDATE = &H100
Public Const OFN_OVERWRITEPROMPT = &H2
Public Const OFN_PATHMUSTEXIST = &H800
Public Const OFN_READONLY = &H1
Public Const OFN_SHAREAWARE = &H4000
Public Const OFN_SHAREFALLTHROUGH = 2
Public Const OFN_SHARENOWARN = 1
Public Const OFN_SHAREWARN = 0
Public Const OFN_SHOWHELP = &H10

Dim DateiDialogStruktur As DateiDialogStruktur

Function DateiOeffnen(Verzeichnis As String, Fenstertitel As String) As String
On Error GoTo Err_DateiOeffnen

   Dim Dateityp As String
   Dim Dateiname_mit_Pfad As String
   Dim Dateiname As String
   Dim Rueckwerte As Long

   Dateityp = ""

' Dateitypen in der Auswahlliste des Dateityp's
'   Alle Dateien
   Dateityp = Dateityp & "Alle Dateien (*.*)" & Chr$(0) & "*.*" & Chr$(0)


   Dateityp = Dateityp & _
   "Microsoft Excel-Datenbanken (*.xlsx)" & Chr$(0) & "*.xlsx" & Chr$(0)

' Vorgegebenes Verzeichnis
   If Verzeichnis = "" Then
       ' Wenn leer, dann soll das aktuelle Verzeichnis verwendet werden
       Verzeichnis = CurDir$ & Chr$(0)
   Else
       ' ANSI "0" an das übergebene Verzeichnis anhängen
       Verzeichnis = Verzeichnis & Chr$(0)
   End If

   If Fenstertitel = "" Then
       ' Wenn kein Titel übergeben worden ist
       Fenstertitel = "Datei öffnen"
   Else
       ' ANSI "0" an übergebenen Fenstertitel anhängen
       Fenstertitel = Fenstertitel & Chr$(0)
   End If

' Speicherplatz für Dateieintrag (mit Pfadangabe) reservieren
   Dateiname_mit_Pfad = Space$(255) & Chr$(0)

' Speicherplatz für Dateieintrag (ohne Pfadangabe) reservieren
   Dateiname = Space$(255) & Chr$(0)

'Datenstruktur von DateiDialogStruktur festlegen
   DateiDialogStruktur.lStructSize = Len(DateiDialogStruktur)
   DateiDialogStruktur.hwndOwner = 0&
   'DateiDialogStruktur.hwndOwner = Application.hWndAccessApp
   DateiDialogStruktur.lpstrFilter = Dateityp
   DateiDialogStruktur.nFilterIndex = 1
   DateiDialogStruktur.lpstrFile = Dateiname_mit_Pfad
   DateiDialogStruktur.nMaxFile = Len(Dateiname_mit_Pfad)
   DateiDialogStruktur.lpstrFileTitle = Dateiname
   DateiDialogStruktur.nMaxFileTitle = Len(Dateiname)
   DateiDialogStruktur.lpstrInitialDir = Verzeichnis
   DateiDialogStruktur.lpstrTitle = Fenstertitel
   DateiDialogStruktur.flags = OFN_FILEMUSTEXIST Or OFN_PATHMUSTEXIST _
   Or OFN_HIDEREADONLY Or OFN_LONGNAMES
   DateiDialogStruktur.nFileOffset = 0
   DateiDialogStruktur.nFileExtension = 0
   DateiDialogStruktur.lCustData = 0
   DateiDialogStruktur.lpfnHook = 0
   DateiDialogStruktur.lpTemplateName = ""

   Rueckwerte = GetOpenFileName(DateiDialogStruktur)

   If Rueckwerte <> 0 Then
       DateiOeffnen = Left(DateiDialogStruktur.lpstrFile, _
       InStr(DateiDialogStruktur.lpstrFile, Chr$(0)) - 1)
   End If

Exit_DateiOeffnen:
   Exit Function

Err_DateiOeffnen:
   MsgBox Err.Description
   Resume Exit_DateiOeffnen

End Function

Pfad = DateiOeffnen("C:\Eigene Dateien", "Datei öffnen")
MsgBox Pfad


If Pfad <> "" Then
DoCmd.TransferSpreadsheet acImport, 8, "import_test", Pfad, True, "Tabelle2!A2:AK2"
End If
ExitSub:
Exit Function

MyErr:
MsgBox Err.Number & ": " & Err.Description
Resume ExitSub
End Function


End Function


Funktionieren tut es aber nicht, ich bin nicht mal sicher ob ich den richtigen Teil kompiert habe, da weiter unten noch zu lesen ist:

Zum Öffnen verwenden Sie innerhalb Ihres Formulars den folgenden Code:
Dim Path As String

Pfad = DateiOeffnen("C:\Eigene Dateien", "Datei öffnen")
MsgBox Pfad

Sorry aber ich durchsteig das gerade überhaupt nicht.

Hat nicht jemand einen fertigen Code, den ich auf meine DB anpassen kann? So selten scheint das Grundproblem ja nicht zu sein

Viele Grüße

[pkoenig]

Hat keiner eine Idee wie das Ganze einfach zu lösen ist?