Hallo.
Ich habe ein paar Fragen zu einem Problem von mir (VBA, Access2013).
Ich bekomme aus einer Warenwirtschaft einen Output / Steuerdatei für eine Etikettendruckdatei.
>>Die TXT Datei bzw. die Daten sind aber von oben nach unten aufgebaut. <<
Ein Datensatz baut sich wie folgt zusammen:
Beginnend mit einem kleinen "r", endend mit einem großen "A" mit einer Zahl (Anzahl der Etiketten).
Die folgenden Zeilen stellen eigene Befehlszeilen dar, beginnend mit einem großen "R" und "Leerzeichen", folgend der Feldname.
Hinter dem Semikolon beginnt der Feldwert. Das große "A" am Ende des Datensatzes wird allerdings nicht getrennt. Also bei zb 3 Etiketten würde da "A3" stehen. Das setzt aber der Etikettendrucker selbst um.
Das Ende des Druckauftrages wird nach dem letzten großen "A" mit einem Carriage Return abgeschlossen.
Mein Problem ist, dass ich keine Ahnung habe, null, wie ich die untereinander stehenden Daten in eine Tabelle (z.B. Name=HWETI_Mehrfach) importieren kann, und daraus gescheite Datensätze bekomme (transponieren ist hier glaube ich das richtige Wort). Umwege über Excel etc. möchte ich mir sparen! Richtig funktioniert hat es auch nicht bei mir bei einem Test.
Um die Daten dann zu drucken würde ich folgenden Script verwenden. Hier baue ich die Datensätze wieder zurück in die Urspungsforms. Allerdings hier in dem Beispiel aus einer manuell angelegten festen Access Tabelle.
Der Sinn der dahinter steckt ist, dass teileweise mehrere tausend von diesen "Datensätzen" in der TXT Datei vorhanden sein können, und ich eine "komfortable" Möglichkeit suche Nachdruckdateien zu generieren. Das würde zwar auch mit einem stinknormalen Texteditor funktionieren, bei dem verliert man aber schnell die Übersicht.
Die Access DB ist also so etwas wie ein Konverter für mich.
Hat jemand eine Idee, oder kann das sogar umsetzen ? :o
Danke und schönes Wochenende.
Anbei mal eine Druckdatei, als Beispiel drei Einzeletiketten:
Zitat
r
M l LBL;HWETI
R MOD_NA;Nack
R MOD_NRAW;47890/0
R ART_NRFB;32346/1253
R LIEF_M;0717
R PL_NR;12/1
R KD_NR;888888
R GROESSE;I
R AUF_NRPO;12345/123
R UVP;5001,95
R W_KZ;EUR
R PRDGRP;Schal
R LOGO;K
R EAN;111111111112
R MGRPFB1;1762
A1
r
M l LBL;HWETI
R MOD_NA;Nuck
R MOD_NRAW;27890/0
R ART_NRFB;12345/1254
R LIEF_M;0717
R PL_NR;12/1
R KD_NR;888888
R GROESSE;I
R AUF_NRPO;12345/123
R UVP;5000,95
R W_KZ;EUR
R PRDGRP;Schal
R LOGO;K
R EAN;111111111113
R MGRPFB1;1762
A1
r
M l LBL;HWETI
R MOD_NA;Nock
R MOD_NRAW;17890/0
R ART_NRFB;12345/1254
R LIEF_M;0717
R PL_NR;12/1
R KD_NR;888888
R GROESSE;I
R AUF_NRPO;22345/123
R UVP;5000,95
R W_KZ;EUR
R PRDGRP;Mütze
R LOGO;K
R EAN;111111111111
R MGRPFB1;1762
A1
VBA Script zur Verarbeitung eines Datensatzes mit meiner jetzigen manuell erstellten Tabelle:
Private Sub Btn_Drucken_Click()
On Error GoTo Err_Btn_Drucken_Click
Dim Printer As String
Dim PrintDat As String
Dim Quelltabelle As String
Dim rs As DAO.Recordset
Dim intFile As Integer
Dim i As Integer
'Variablen fuellen
PrintDat = "\\Printserver\spool\HWETI_Zieldatei"
Printer = "\\Printserver\" & Me.Drucker
Quelltabelle = "HWETI_Mehrfach"
'Verbindung zum Netzlaufwerk herstellen
Shell ("cmd.exe /c net use \\printserver\spool /u:domain\user password")
'Bei fehlgeschlagenen Vorgang Ausgabedatei vorher schließen
Close #intFile
'Neue / Leere Ausgabedatei erstellen und zur Bearbeitung oeffnen
intFile = FreeFile
Open PrintDat For Output As #intFile
'Quelltabelle aus Access einlesen
Set rs = DBEngine(0)(0).OpenRecordset( _
Quelltabelle, _
dbOpenForwardOnly, _
dbReadOnly)
With rs
Do While Not .EOF
'##Erste Steuerzeichen in die Steuerdatei schreiben die nicht in der Quelldatei vorhanden sind
Print #intFile, "r"
Print #intFile, "M l LBL;HWETI"
Print #intFile, "R LOGO;K"
'##Lesen und verarbeiten der Datensaetze aus Quelldatei
'----------------------------------------------------------------
'##Variante 1 - ... Wenn "A" dann ohne "R"
'For i = 0 To .Fields.Count - 1
'If rs(i).Name = "A" Then
'Print #intFile, rs(i).Name & Nz(rs(i))
'Else
'Print #intFile, "R "; rs(i).Name & ";" & Nz(rs(i))
'End If
'Next i
'----------------------------------------------------------------
'##Variante 2 - ... 1-Vorletzter Datenstring MIT "R " (Count -2)
For i = 0 To .Fields.Count - 2
Print #intFile, "R "; .Fields(i).Name & ";" & .Collect(i)
Next
' i hat hier den Wert von .Count - 1 ; Letzter String ohne "R "
Print #intFile, .Fields(i).Name & .Collect(i)
'----------------------------------------------------------------
.MoveNext
Loop
.Close
End With
Close #intFile
Set rs = Nothing
'##Ende der Schleife - Verarbeitung
'Verbindung zum Drucker herstellen
Shell ("cmd.exe /c net use \\Printserver\ipc$ /u:domain\drucker drucker")
'Ausgabedatei an Drucker senden
Shell ("cmd.exe /c copy /b" & " " & PrintDat & " " & Printer)
'Warte 10 Sekunden bis Ausgabedatei geloescht wird
'Sleep 10000
'Kill PrintDat
Exit_Btn_Drucken_Click:
Exit Sub
Err_Btn_Drucken_Click:
MsgBox Err.Description
Resume Exit_Btn_Drucken_Click
End Sub
Folgenden Code habe ich aus einer fremden Beispieldatenbank gefischt, den ich für mich nicht umsetzen kann. Da gehen die Klappen bei mir runter :-[. Ich weiß nicht mal ob das Sinn für mich macht.
Kann das jemand für mich auf mein Projekt über- /umsetzen??? Ist dass das was ich brauche :P
Option Compare Database
Option Explicit
Sub Import(DateiName As String, ZielTab As String)
' Verweis auf Microsoft DAO setzen
' HIER ANPASSEN
' ============================================================================
' Const DateiName = "C:\Dokumente und Einstellungen\Steffen\Desktop\test1.txt"
' Const ZielTab = "TabLiteratur" ' Tabelle wird angelegt, wenn nicht vorhanden
' ============================================================================
' erster Durchlauf Kontrolle ob alle Spalten angelegt,
' ansonsten anlegen als Text 255 Zeichen
FelderAnlegen DateiName, ZielTab
' Einfügen der Daten
Literatur2Tabelle DateiName, ZielTab
End Sub
Sub Literatur2Tabelle(DateiName As String, TabName As String)
Dim DS As DAO.Recordset
Dim AktDB As DAO.Database
Dim Zeile As String, FeldName As String, FeldInhalt As String
Dim IDatNum As Integer
Set AktDB = CurrentDb
Set DS = AktDB.OpenRecordset(TabName)
IDatNum = FreeFile
CurrentDb.Execute ("DELETE * FROM " & TabName) ' evt. Tabelle leeren
Open DateiName For Input As IDatNum
DS.AddNew
Do While Not EOF(IDatNum)
Line Input #IDatNum, Zeile
Zeile = KorrUmlaut(Zeile)
Select Case Mid(Zeile, 15, 1)
Case ":":
FeldName = KorrFeldName(Mid(Zeile, 1, 14))
FeldInhalt = Trim(Mid(Zeile, 16))
If IsNull(DS(FeldName)) Then
DS(FeldName) = FeldInhalt
Else
DS(FeldName) = DS(FeldName) & vbCrLf & FeldInhalt ' Mehrfachspalte
End If
Case "":
DS.Update ' Ende des Datensatzes
DS.AddNew
Case Else:
DS(FeldName) = DS(FeldName) & " " & Trim(Zeile) ' Zusatzzeile
End Select
Loop
End Sub
Sub FelderAnlegen(DateiName As String, TabName As String)
Dim IDatNum As Integer
Dim Zeile As String
IDatNum = FreeFile
Open DateiName For Input As IDatNum
Do While Not EOF(IDatNum)
Line Input #IDatNum, Zeile
Zeile = KorrUmlaut(Zeile)
If Mid(Zeile, 15, 1) = ":" Then
TextFeldAnlegen TabName, KorrFeldName(Mid(Zeile, 1, 14))
End If
Loop
End Sub
Function KorrFeldName(AltFeldName As String) As String
' Bildung eines "vernünftigen" Feldnamens
Dim TmpText As String
TmpText = Replace(AltFeldName, "-", "_") ' eigentlich erlaubt
TmpText = Replace(TmpText, "/", "_") ' eigentlich erlaubt
TmpText = Replace(TmpText, ".", "_")
TmpText = Replace(TmpText, "!", "_")
TmpText = Replace(TmpText, "`", "_")
TmpText = Replace(TmpText, "[", "_")
KorrFeldName = Trim(Replace(TmpText, "]", "_"))
End Function
Function KorrUmlaut(MyText As String) As String
' Korrektur der Umlaute
' z.Z werden nur Ü,ä,ö,ü,ß konvertiert
Dim TmpText As String, i As Integer
TmpText = Replace(MyText, Chr(&H81), "ü")
TmpText = Replace(TmpText, Chr(&H84), "ä")
TmpText = Replace(TmpText, Chr(&H94), "ö")
TmpText = Replace(TmpText, Chr(&H9A), "Ü")
TmpText = Replace(TmpText, Chr(&HE1), "ß")
' For i = 1 To Len(TmpText)
' If Asc(Mid(TmpText, i, 1)) > &H80 Then Debug.Print Mid(TmpText, i, 1);
' Next i
KorrUmlaut = TmpText
End Function
Sub TextFeldAnlegen(Tabelle As String, SpaltenName As String)
' Anlegen eine Textfeldes (falls noch nicht existent)
' Wenn Tabelle nicht exisiert wirrd diese auch angelegt
Dim i As Integer, TableExist As Boolean
Dim tdf As DAO.TableDef
Dim AktDB As DAO.Database
Set AktDB = CurrentDb
For i = 0 To AktDB.TableDefs.Count - 1
If AktDB.TableDefs(i).Name = Tabelle Then TableExist = True
Next i
If Not TableExist Then
Set tdf = AktDB.CreateTableDef(Tabelle)
tdf.Fields.Append tdf.CreateField(SpaltenName, dbText, 255)
tdf.Fields(SpaltenName).AllowZeroLength = True
AktDB.TableDefs.Append tdf
Else
Set tdf = AktDB.TableDefs(Tabelle)
For i = 0 To tdf.Fields.Count - 1
If tdf.Fields(i).Name = SpaltenName Then Exit Sub
Next i
tdf.Fields.Append tdf.CreateField(SpaltenName, dbText, 255)
tdf.Fields(SpaltenName).AllowZeroLength = True
End If
Set tdf = Nothing
Set AktDB = Nothing
End Sub
Hallo
ablaufähnlich betrachtet ja.
Hier mal luftcode, weil ich jetzt keine Tabellen nachbauen will, setzt auch vorraus das allen in der Textdatei vorkommenden Feldnamen in der importtabelle vorhanden sind:
Open "Deine Text Datei" For Input As #1
Set r = CurrentDb.OpenRecordset("Name der Tabelle")
Do Until EOF(1) = True
Line Input #1, sline
Select Case Asc(Left(sline, 1))
Case Asc("r")
r.AddNew
Case Asc("R")
sline = Mid(sline, 3)
r(Split(sline, ";")(0)) = Split(sline, ";")(1)
Case Asc("A")
r.Update
End Select
Loop
r.close
Close #1
Hallo.
Danke für die Antwort.
Ich wollte das nicht unbeantwortet lassen. Nur ich komme im Moment leider nicht dazu es zu testen.
Wenn ich wieder dran kann würde ich mich noch einmal melden.
Danke noch einmal.
mfg
Hallo nochmal.
Es hat mich nicht losgelassen. Aber ich bekomme es nicht hin.
Bei der Line Input Anweisung gibt er Syntaxfehler aus, und ich kenne mich nicht gut genug aus.
Private Sub test2_Click()
On Error GoTo Err_test2_Click
Dim DateiName As String
Dim ZielTab As String
DateiName = "d:\User\DruckfileImport\test.txt"
ZielTab = "ImportTabelle_1"
Dim r As DAO.Recordset
Dim AktDB As DAO.Database
Dim sline
Set AktDB = CurrentDb
Set r = AktDBb.OpenRecordset(ZielTab)
Open DateiName For Input As #1
Do Until EOF(1) = True
Line Input #1, sline
Select Case Asc(Left(sline, 1))
Case Asc("r")
r.AddNew
Case Asc("R")
sline = Mid(sline, 3)
r(Split(sline, ";")(0)) = Split(sline, ";")(1)
Case Asc("A")
r.Update
End Select
Loop
r.close
Close #1
Exit_test2_Click:
Exit Sub
Err_test2_Click:
MsgBox Err.Description
Resume Exit_test2_Click
End Sub
Hallo,
ZitatBei der Line Input Anweisung gibt er Syntaxfehler aus
Kann ich mir nicht vorstellen. Wie lautet denn der Fehler?
Falsch ist dagegen:
ZitatSet r = AktDBb.OpenRecordset(ZielTab)
Du solltest in einem Testcode keine LZ-Fehlerbehandlung einbauen/aktivieren.
Zitat von: steffen0815 am Juli 18, 2017, 17:49:20
Hallo,ZitatBei der Line Input Anweisung gibt er Syntaxfehler aus
Kann ich mir nicht vorstellen. Wie lautet denn der Fehler?
Falsch ist dagegen:ZitatSet r = AktDBb.OpenRecordset(ZielTab)
Btw:
Du solltest in einem Testcode keine LZ-Fehlerbehandlung einbauen/aktivieren.
Hallo.
Danke für das "b". Hab ich übersehen.
Fehlermeldung lautet beim bearbeiten ab Line Input "Fehler beim kompilieren. Erwartet: Anweisungsende".
Bei der Ausführung "Fehler beim kompilieren. Syntaxfehler"
Von "Line Input bis Close #1" alles in roter Schrift. :-\
Hallo,
ZitatVon "Line Input bis Close #1" alles in roter Schrift
Gibt es evtl. Unterstriche als Zeilentrennzeichen?
Poste den ganzen Code nochmal mit Copy&Paste
Hallo.
Copy & Paste 8)
Access 2013, als .accdb gespeichert, passt auch.
Private Sub test2_Click()
On Error GoTo Err_test2_Click
Dim DateiName As String
Dim ZielTab As String
DateiName = "d:\User\DruckfileImport\test.txt"
ZielTab = "ImportTabelle_1"
Dim r As DAO.Recordset
Dim AktDB As DAO.Database
Dim sline
Set AktDBb = CurrentDb
Set r = AktDBb.OpenRecordset(ZielTab)
Open DateiName For Input As #1
Do Until EOF(1) = True
Line Input #1, sline
Select Case Asc(Left(sline, 1))
Case Asc("r")
r.AddNew
Case Asc("R")
sline = Mid(sline, 3)
r(Split(sline, ";")(0)) = Split(sline, ";")(1)
Case Asc("A")
r.Update
End Select
Loop
r.close
Close #1
Exit_test2_Click:
Exit Sub
Err_test2_Click:
MsgBox Err.Description
Resume Exit_test2_Click
End Sub
Das Microsoft Beispiel sieht ähnlich aus:
Dim TextLine
Open "TESTFILE" For Input As #1 ' Open file.
Do While Not EOF(1) ' Loop until end of file.
Line Input #1, TextLine ' Read line into variable.
Debug.Print TextLine ' Print to the Immediate window.
Loop
Close #1 ' Close file.
Hallo,
der Fehler
ZitatSet AktDBb = CurrentDb
ist immer noch drin.
Und wie beschrieben, kann hier eigentlich kein Syntaxfehler bei
Line Input #1, slineauftreten
Es hilft hier wohl nur, dass du mal eine (abgespeckte) Version der DB hochlädtst.
Hallo,
konkret:
Private Sub test2_Click()
On Error GoTo Err_test2_Click
Dim DateiName As String
Dim ZielTab As String
Dim r As DAO.Recordset
Dim AktDB As DAO.Database
Dim sline As String
Dim LU As Long
DateiName = "d:\User\DruckfileImport\test.txt"
ZielTab = "ImportTabelle_1"
Set AktDB = CurrentDb
Set r = AktDB.OpenRecordset(ZielTab)
LU = FreeFile
Open DateiName For Input As LU
Do Until EOF(LU) = True
Line Input #LU, sline
Select Case Asc(Left(sline, 1))
Case Asc("r")
r.AddNew
Case Asc("R")
sline = Mid(sline, 3)
r(Split(sline, ";")(0)) = Split(sline, ";")(1)
Case Asc("A")
r.Update
End Select
Loop
Exit_test2_Click:
If Not r Is Nothing Then r.Close: Set r = Nothing
Close LU
Exit Sub
Err_test2_Click:
MsgBox Err.Description
Resume Exit_test2_Click
End Sub
Weiterhin: In allen(!) Modulköpfen Option Explicit einsetzen und im VBA-Editor Debuggen/Kompilieren durchführen!
Franz, ich verneige mich vor Dir.
Das sieht wiedermal spitzenmäßig aus. Danke !!! Da kommen richtig Glücksgefühle auf ;)
Der Import funktioniert bis auf eine Kleinigkeit. Ich würde es gar nicht erwähnen, aber wenn das auch noch gelöst werden würde wäre es perfekt.
In der letzten Zeile eines Etikettes wird der Wert / die Menge hinter dem "A" nicht importiert. Das Feld in der Tabelle bleibt leider leer. Es gibt auch keine Fehlermeldung, wie z.B. Objekt nicht gefunden o.ä..
Aber, TOP !!!
Danke.
Hallo,
im Beispiel stehen nur Zeilen mit (statischem) "A1" am Anfang....
Meinst Du diese Zeilen? Die passten aber nicht in das "Bezeichnung/Menge"-Format. Und warum sollten die importiert werden? Die sind immer gleich.
Und wie heißt das entsr. Feld in der Tabelle?
Hallo.
Nein, in dem Beispiel werden nur jeweils Menge 1, also A1, benötigt.
Und das ist das Ende des Etiketts.
Dort kann aber auch eine andere Menge hinterlegt sein... A2, A20... also Ax.
Das A ist statisch, die Zahl dahinter variabel.
Die Bezeichnungen r,M,R,A in der Beispieldatei sind Steuerzeichen für den Drucker.
Für die Druckmenge (Feld A) wird kein Trennzeichen ";" benutzt.
Aufbau (verkürzt):
Zitat
r -> neues Etikett
M l LBL;HWETI -> Layoutdatei auf dem Drucker (Positionierung der Felder)
R MOD_NA;Nack -> Feldname auf Layoutdatei;Feldwert
R MOD_NRAW;47890/0 -> Feldname auf Layoutdatei;Feldwert
A1 -> Anzahl Etiketten ("Ax")
Hallo,
ok,
d.h. die Anzahl der Etiketten soll auch importiert werden ("M" dagegen nicht).
Wie heißt das Tabellenfeld für die Anzahl und welchen Datentyp hat das Feld?
Hallo,
erweitere den Code wie nachstehend:
Zitat.
.
.
Case Asc("A")
r("EtikAnz") = Clng(mid (sline,2)) 'Tabellenfeld heißt "EtikAnz" und hat Datentyp LONG
r.Update
End Select
.
.
Hallo.
Richtig. Die statischen Felder, wo nur das Layout drin steht fummel ich mir wieder in die Ausgabe, wenn ich den Weg wieder zurück nach der Bearbeitung in die Txt Ausgabe gehe.
Also, ich für meinen Teil gehe heute Lotto spielen. ::)
Herzlichen Dank. 100% :) ;) ;D
Hier jetzt einmal komplett:
Private Sub test2_Click()
On Error GoTo Err_test2_Click
Dim DateiName As String
Dim ZielTab As String
Dim r As DAO.Recordset
Dim AktDB As DAO.Database
Dim sline As String
Dim LU As Long
DateiName = "d:\User\DruckfileImport\test.txt"
ZielTab = "ImportTabelle_1"
Set AktDB = CurrentDb
Set r = AktDB.OpenRecordset(ZielTab)
LU = FreeFile
Open DateiName For Input As LU
Do Until EOF(LU) = True
Line Input #LU, sline
Select Case Asc(Left(sline, 1))
Case Asc("r")
r.AddNew
Case Asc("R")
sline = Mid(sline, 3)
r(Split(sline, ";")(0)) = Split(sline, ";")(1)
Case Asc("A")
r("A") = CLng(Mid(sline, 2))
r.Update
End Select
Loop
Exit_test2_Click:
If Not r Is Nothing Then r.Close: Set r = Nothing
Close LU
Exit Sub
Err_test2_Click:
MsgBox Err.Description
Resume Exit_test2_Click
End Sub