TXT importieren und transponieren

[ReneK]

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 ? 

Danke und schönes Wochenende.


Anbei mal eine Druckdatei, als Beispiel drei Einzeletiketten:

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:

Code [Auswählen] Erweitern


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 

Code [Auswählen] Erweitern


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


[daolix]

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:

Code [Auswählen] Erweitern

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


[ReneK]

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

[ReneK]

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.

Code [Auswählen] Erweitern


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


[steffen0815]

Hallo,

Bei der Line Input Anweisung gibt er Syntaxfehler aus

Kann ich mir nicht vorstellen. Wie lautet denn der Fehler?

Falsch ist dagegen:

Set r = AktDBb.OpenRecordset(ZielTab)

Du solltest in einem Testcode keine LZ-Fehlerbehandlung einbauen/aktivieren.

[steffen0815]

Hallo,

Bei der Line Input Anweisung gibt er Syntaxfehler aus

Kann ich mir nicht vorstellen. Wie lautet denn der Fehler?

Falsch ist dagegen:

Set r = AktDBb.OpenRecordset(ZielTab)

Btw:
Du solltest in einem Testcode keine LZ-Fehlerbehandlung einbauen/aktivieren.

[ReneK]

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. 

[DF6GL]

Hallo,

Von "Line Input bis Close #1" alles in roter Schrift

Gibt es evtl.  Unterstriche als Zeilentrennzeichen?


Poste den ganzen Code nochmal mit Copy&Paste

[ReneK]

Hallo.

Copy & Paste 

Access 2013, als .accdb gespeichert, passt auch.

Code [Auswählen] Erweitern


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:

Code [Auswählen] Erweitern


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.


[steffen0815]

Hallo,
der Fehler

Set AktDBb = CurrentDb

ist immer noch drin.

Und wie beschrieben, kann hier eigentlich kein Syntaxfehler bei

Code [Auswählen] Erweitern

Line Input #1, slineauftreten

Es hilft hier wohl nur, dass du mal eine (abgespeckte) Version der DB hochlädtst.

[DF6GL]

Hallo,

konkret:

Code [Auswählen] Erweitern

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!

[ReneK]

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.

[DF6GL]

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?

[ReneK]

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):

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")

[DF6GL]

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?