Hallo Acces-Profis,
bin auf der Suche nach einer Lösung meines Problems.
Ich möchte gerne den Dateinamen einer zu importierender Datei auflösen und in jeden einzelnen Datensatz speichern.
z.Bspl. Dateiname: 0001_5896321_ST_05
0001 = Position auf der übergeordnete Stückliste (soll in Feld: VaterST)
5896321 = Stücklistennummer (soll in Feld: Stueckliste)
ST = gibt an das es sich um eine Stückliste handelt (z.Zt. nicht benötigt)
05 = Revisionsnummer der Stückliste (soll in Feld: Stueckliste_Rev)
Nun möchte ich das u.g. Spalten meiner Tabelle "tblHaupt_Stuecklisten" mit o.g. Werten/Zahlen gefüllt werden. Es soll für jede Zeile der zu importierende Tabelle passieren. Später wird diese Tabelle dann wieder zerlegt per Abfrage und in anderen Tabellen gespeichert.
Zur Zeit ist es so, dass mit u.g. Code die Tabelle importiert wird in "tblImport_Stuecklisten" und dann per Anfügeabfrage in Tabelle "tblHaupt_Stuecklisten" hinzugefügt wird. Leider schreibt der Code den Dateinamen mit Extension in einer neuen Zeile. Ich möchte aber dass der Dateiname aufgelöst wird und in verschiedenen Spalten (siehe oben) eingetragen wird.
Der jetzige Code
=== QUOTE ===
Private Sub cmd_Import_Stuecklisten_Click()
Dim Dateipfad As String
Dim Datei As String
Dim Datei1 As String
Dim dlg As Object
Set dlg = Application.FileDialog(3)
'Titelzeile
dlg.Title = "Bitte Exceldatei(en) auswählen !"
'standardpfad
dlg.InitialFileName = "E:\Test\"
'Button text
dlg.AllowMultiSelect = True
dlg.ButtonName = "Importieren"
dlg.Filters.Clear
dlg.Filters.Add "Excel", "*.xls*"
If dlg.Show Then
DoCmd.SetWarnings False
Dateipfad = dlg.SelectedItems(1) 'Pfad in Variable
Datei = Dir(Dateipfad)
DoCmd.TransferSpreadsheet acImport, , "tblImport_Stuecklisten", Dateipfad, True
DoCmd.RunSQL "INSERT INTO tblImport_Stuecklisten(Stueckliste) Values ('" & Datei & "')", dbFailOnError
If IsNull(DLookup("([Sach-Nr])", "qryNeueDaten")) Then
MsgBox "Keine neuen Datensätze vorhanden."
Else
DoCmd.OpenQuery "qryHinzufuegen", acViewNormal
End If
Dim SQLdelete As String
SQLdelete = "delete * from tblImport_Stuecklisten"
DoCmd.RunSQL SQLdelete
DoCmd.SetWarnings True
End If
End Sub
== UNQUOTE ==
Dateiname:0011_6512344_ST_00.xls
Das Ergebnis sollte in der Tabelle so aus sehen:
Pos Typ Menge Sach-Nr Stueckliste Stueckliste_Rev VaterST
1 L 1.0 ST AG12356 6512344 00 0011
2 L 1.0 ST 256389 6512344 00 0011
3 L 1.0 ST 6551245 6512344 00 0011
4 L 1.0 ST 630550 6512344 00 0011
5 L 1.0 ST R272791 6512344 00 0011
Danke für Eure Hilfe im voraus.
Hallo,
kopiere folgende Funktion in ein Standardmodul und ruf sie in einer Anfügeabfrage auf.
Public Function fktSplitFN(FN As String, pos As Long)
Dim a
On Error GoTo myerr
If pos < 0 Or pos > 3 Then Err.Raise 1
a = Split(FN, "_")
If pos = 3 Then
fktSplitFN = Split(a(pos), ".")(0)
Else
fktSplitFN = a(pos)
End If
exit_func:
Exit Function
myerr:
fktSplitFN = Null
Resume exit_func
End Function
Currentdb.Execute "INSERT INTO tblImport_Stuecklisten(Stueckliste, Stueckliste_Rev, VaterST) Values ("' & fktSplit(Datei,1) & "','" & fktSplit(Datei,3) & "','" & fktSplit(Datei,0) & "')", dbFailOnError
Die restlichen anzufügenden Felder sind noch einzubauen.
Hallo,
danke erstmal für die schnelle Rückmeldung. Ich muss mit Access 2013 (64bit) arbeiten.
Ich bin noch ein blutiger Anfänger was Access, VBA und SQL angeht. Habe mir alles aus
dem Netzt zusammen gesucht und meinen Bedürfnissen angepasst. Mit try and error bin ich
bis hierhin gekommen.
Habe dein Code in Modul1 gepackt (1 zu 1). Kein weiterer Code drin.
Wo muss ich jetzt den SQL-code hinpacken ?
den "INSERT INTO"-Befehlt steht doch schon in meine "Privat Sub" für mein Button.
ich habe 2 Abfragen
qryNeueDaten
SELECT tblImport_Stuecklisten.Pos, tblImport_Stuecklisten.Typ, tblImport_Stuecklisten.Menge, tblImport_Stuecklisten.Einheit, tblImport_Stuecklisten.Benennung, tblImport_Stuecklisten.[Sach-Nr], tblImport_Stuecklisten.Bemerkung, tblImport_Stuecklisten.Stueckliste
FROM tblImport_Stuecklisten LEFT JOIN tblHaupt_Stuecklisten ON tblImport_Stuecklisten.[Sach-Nr] = tblHaupt_Stuecklisten.[Sach-Nr]
WHERE (((tblHaupt_Stuecklisten.[Sach-Nr]) Is Null));
qryHinzufuegen
INSERT INTO tblHaupt_Stuecklisten ( Pos, Typ, Menge, Einheit, Benennung, [Sach-Nr], Bemerkung, Stueckliste )
SELECT qryNeueDaten.Pos, qryNeueDaten.Typ, qryNeueDaten.Menge, qryNeueDaten.Einheit, qryNeueDaten.Benennung, qryNeueDaten.[Sach-Nr], qryNeueDaten.Bemerkung, qryNeueDaten.Stueckliste
FROM qryNeueDaten;
Hallo,
Achtung: geänderte Insert-SQL in meinem letzten Post.
ZitatDoCmd.TransferSpreadsheet acImport, , "tblImport_Stuecklisten", Dateipfad, True
DoCmd.RunSQL "INSERT INTO tblImport_Stuecklisten(Stueckliste) Values ('" & Datei & "')", dbFailOnError
If IsNull(DLookup("([Sach-Nr])", "qryNeueDaten")) Then
MsgBox "Keine neuen Datensätze vorhanden."
Else
DoCmd.OpenQuery "qryHinzufuegen", acViewNormal
End If
Die blau markierte Anweisung dürfte unlogisch sein..
Zitat
Wo muss ich jetzt den SQL-code hinpacken ?
Das ist kein SQL-Code, sondern VBA-Code, der ein SQL-Statement zusammensetzt und dann ausführt.
Zitatden "INSERT INTO"-Befehlt steht doch schon in meine "Privat Sub" für mein Button.
Der ist eh falsch und muss gelöscht werden.
Neuer Vorschlag nach Kenntnis der Abfragen. Korrigiere Deinen Code entsprechend den folgenden:
.
.
.
DoCmd.TransferSpreadsheet acImport, , "tblImport_Stuecklisten", Dateipfad, True
If IsNull(DLookup("([Sach-Nr])", "qryNeueDaten")) Then
MsgBox "Keine neuen Datensätze vorhanden."
Else
Currentdb.Execute "INSERT INTO tblHaupt_Stuecklisten ( Pos, Typ, Menge, Einheit, Benennung, [Sach-Nr], Bemerkung, Stueckliste, Stueckliste_Rev, VaterST ) " & _
" SELECT Pos, Typ, Menge, Einheit, Benennung, [Sach-Nr], Bemerkung, '" & fktSplit(Datei,1) & "' as Stueckliste, '" & fktSplit(Datei,3) & "' as Stueckliste_Rev, '" & fktSplit(Datei,0) & "' as VaterST " & _
" FROM qryNeueDaten"
End If
.
.
Currentdb.Execute "INSERT INTO tblHaupt_Stuecklisten ( Pos, Typ, Menge, Einheit, Benennung, [Sach-Nr], Bemerkung, Stueckliste, Stueckliste_Rev, VaterST ) " & _
" SELECT Pos, Typ, Menge, Einheit, Benennung, [Sach-Nr], Bemerkung, '" & fktSplit(Datei,1) & "' as Stueckliste, '" & fktSplit(Datei,3) & "' as Stueckliste_Rev, '" & fktSplit(Datei,0) & "' as VaterST " & _
" FROM qryNeueDaten"
Im o.g. Code steht fktSplit im Modul steht aber fktSplitFN muss dass so sein ?
Leider weiss ich auch nicht wie "Function" in der Privat Sub aufgerufen wird.
Wenn ich schreibe "Function fktSPlitFN(FN)" und dann "End Function", sagt er mir immer "End Sub" fehlt.
Ich bin eben ein Newbie :'(
Hallo,
ja, es muss so heißen:
Currentdb.Execute "INSERT INTO tblHaupt_Stuecklisten ( Pos, Typ, Menge, Einheit, Benennung, [Sach-Nr], Bemerkung, Stueckliste, Stueckliste_Rev, VaterST ) " & _
" SELECT Pos, Typ, Menge, Einheit, Benennung, [Sach-Nr], Bemerkung, '" & [color=red]fktSplitFN[/color](Datei,1) & "' as Stueckliste, '" & [color=red]fktSplitFN[/color](Datei,3) & "' as Stueckliste_Rev, '" & [color=red]fktSplitFN[/color](Datei,0) & "' as VaterST " & _
" FROM qryNeueDaten"ZitatLeider weiss ich auch nicht wie "Function" in der Privat Sub aufgerufen wird.
Wenn ich schreibe "Function fktSPlitFN(FN)" und dann "End Function", sagt er mir immer "End Sub" fehlt.
Was meinst Du damit?
Warum willst Du die Funktion aufrufen?
Die Funktion wird in der Insert-Abfrage aufgerufen, indem man ihren Namen und die dazugehörenden Übergabe-Parameter einsetzt.
Wenn Du die Wirkungsweise der Funktion sehen willst, so gibt deren Rückgabewert mittels der Msgbox aus:
.
.
Dateipfad = dlg.SelectedItems(1) 'Pfad in Variable
Datei = Dir(Dateipfad)
Msgbox fktSplit(Datei,1) & " " & fktSplit(Datei,3) & " " & fktSplit(Datei,0)
.
.
ZitatIch bin eben ein Newbie
Dann ist angeraten, sich die Grundlagen von Access, SQL und VBA zu verinnerlichen.
Hi,
ZitatWenn ich schreibe "Function fktSPlitFN(FN)" und dann "End Function", sagt er mir immer "End Sub" fehlt.
du kannst die Prozeduren nicht ineinander verschachteln, am besten du speicherst die Split-Funktion in einem allgemeinen Modul und unter einem anderen Namen.
Hi,
wenn ich mich zitieren darf:
Zitatkopiere folgende Funktion in ein Standardmodul und ruf sie in einer Anfügeabfrage auf.
Ich habe es geschaft :) ;) :D;D
Im Code steht jetzt:
Private Sub cmd_Import_Stuecklisten_Click()
'hier werden die Variablen deklariert
Dim Dateipfad As String
Dim Datei As String
Dim dlg As Object
'Öffnet Dialogbox für die Auswahl der Datei
Set dlg = Application.FileDialog(3)
'Titelzeile im Dialogbox
dlg.Title = "Bitte Exceldatei(en) auswählen !"
'Standardpfad
dlg.InitialFileName = "E:\Test\"
'Mehrfachauswahl erlauben
dlg.AllowMultiSelect = True
'Button text
dlg.ButtonName = "Importieren"
dlg.Filters.Clear
'Nur Dateien mit Endung XLS sichtbar
dlg.Filters.Add "Excel", "*.xls"
If dlg.Show Then
' Warnungen ausschalten
DoCmd.SetWarnings False
'Pfad in Variable
Dateipfad = dlg.SelectedItems(1)
'Dateiname der importierende Datei inklusive Endung wird ausgelesen
Datei = Dir(Dateipfad)
'Schreibe die Daten in der Tabelle tblImport_Stueckliste ohne Angabe der Excelversion. True heisst, dass die Tabelle überschriften hat.
DoCmd.TransferSpreadsheet acImport, , "tblImport_Stuecklisten", Dateipfad, True
'wenn keine neue Sachnummer vorhande wird
If IsNull(DLookup("([Sach-Nr])", "qryNeueDaten")) Then 'dann
'wird eine Nachricht gezeigt
MsgBox "Keine neuen Datensätze vorhanden."
Else
'hier werden die Daten in der Tabelle tblHaupt_Stuecklisten geschrieben und den Dateinamen aufgelöst in 3 Bestandteile. Die Funktion fktSplitFN ist in ein Modul gespeichert. Stammt von DF6GL
CurrentDb.Execute "INSERT INTO tblHaupt_Stuecklisten ( Pos, Typ, Menge, Einheit, Benennung, [Sach-Nr], Bemerkung, Stueckliste, [Stueckliste_Rev], [Pos_VaterST] ) " & _
" SELECT Pos, Typ, Menge, Einheit, Benennung, [Sach-Nr], Bemerkung, '" & fktSplitFN(Datei, 1) & "' as Stueckliste, '" & fktSplitFN(Datei, 3) & "' as [Stueckliste_Rev], '" & fktSplitFN(Datei, 0) & "' as [Pos_VaterST] " & _
" FROM qryNeueDaten"
End If
'Hier wird die Tabelle tblImport_Stuecklisten geleert
Dim SQLdelete As String
SQLdelete = "delete * from tblImport_Stuecklisten"
DoCmd.RunSQL SQLdelete
'Warnungen wieder einschalten
DoCmd.SetWarnings True
End If
End Sub
Und hier das Modul von DF6GL bezogen auf das Auflösen folgender Zeichenfolge / Dateiname
0001_5896321_ST_05.xls
Public Function fktSplitFN(FN As String, pos As Long)
Dim a
On Error GoTo myerr
If pos < 0 Or pos > 3 Then Err.Raise 1
a = Split(FN, "_")
If pos = 3 Then
fktSplitFN = Split(a(pos), ".")(0)
Else
fktSplitFN = a(pos)
End If
exit_func:
Exit Function
myerr:
fktSplitFN = Null
Resume exit_func
End Function
Vielleicht schreibt DF6GL noch etwas zu den einzelnen Funktionen der o.g. Funktion.
Ich möchte hier nichts falsches erzählen.
Vielen Dank nochmal für die Unterstützung und geduld mit mir DF6GL
Melde mich bald bestimmt wieder.
Hallo,
naja, da gibt es nicht viel zu erklären... Wenn jemand eine konkrete Frage dazu hat, kann er sie ja stellen...
ein problem gibt es noch.
wenn eine sachnummer auf mehreren stücklisten vorhanden ist, dann wird nur der letzte import erhalten. die sachnummer wird nicht mit der zusätzliche stücklistenummer eingetragen.
habe es versucht wie folgt zu lösen:
If IsNull(DLookup("([Sach-Nr]) & (Stueckliste)", "qryNeueDaten")) Then
MsgBox "Keine neuen Datensätze vorhanden."
und
If IsNull(DLookup("([Sach-Nr])", "qryNeueDaten")) and
IsNull (DLookup("(Stueckliste)", "qryNeueDaten")) Then
MsgBox "Keine neuen Datensätze vorhanden."
Hat jemand vielleicht eine idee ?