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
Hallo,
einfach in die VBA-Hilfe zu Transferspreadsheet schauen, dort ist der "Bereich"-Parameter beschrieben.
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?
Hallo,
sinnvoll wäre den Code und die Fehlermeldung zu posten...
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
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
Hallo.
Jetzt zeigt Access an, dass nach EndFunktion, EndSub, ... nur kommentare stehen dürfen.
Mein Code ist jetzt ellenlang und sieht so aus:
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:
ZitatZum Ö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
Hat keiner eine Idee wie das Ganze einfach zu lösen ist? :(