Teile einer CSV Datei in Access Formular einfügen

[Sproket_1972]

Schönen Sonntag Lachtaube,
habe die die Test5 Datei als zip angehängt.
Habe die Sache nicht mehr aus gext sondern
anders benannt.
Hoffe du kannst mit dem was anfangen.
Es ist ja klar dass man aus rudimentären Dateien keine Wunderwerk extrahieren kann.
Also hoffe und Glaube !

[Lachtaube]

Schau mal, ob das so genügt.

[Sproket_1972]

Moin Hallo,
habe die Datei getestet.
Mit der test5.csv klappt es prima
aber mit der Orginal Datei sagt er mir:
Fehlernr_2147221501
Fehler beim verarbeite der Datenkanalzeile.
Wenn ich in die Tabelle"Datenkanal" schaue hat er das ganz prima ausgefüllt.
So wie es aussieht findet er keine Ende und bricht dann mit der Fehlermeldung ab.
Unter der Tabelle "Kunde" hat er mir einen Kundennamen angelegt.
habe die *.jpeg angehängt.

[Lachtaube]

Ich kann nur von Fakten ausgehen, die mir vorliegen. Wenn Du nicht mehr Informationen liefern kannst, musst Du selbst versuchen, strukturelle Unterschiede zwischen dem Beispiel und dem Original in der Datenkanalzeile zu ermitteln.

PS: Riesen-Screenshots sind einer Problemlösung kaum dienlich.

[Sproket_1972]

Hallo,
ja richtig !
Habe jetzt den Code durchlaufen lassen:
Der Abruck kommt bei
Private Function ProcessDatenKanalLine(db As DAO.Database, l$)
der Abbruch kommt bei
If .NoMatch = Wahr

und dann wenn er versucht das : .Update
zu machen.
siehe auch *.jpg<<< diesmal mit mehr Aussagekraft

Grüße von der Spätschicht !!!
   

[Lachtaube]

Ich vermute eher, dass Du das Beispiel in der Zeile Datenkanal: beim Editieren vergeigt hast - prüfen musst Du das selbst. Oder gibt es auch leere Positionen in der Zeile?

Und noch einmal: anhand von Screenshots kann ich Dir nicht helfen. Der Fehler liegt vermutlich in einer unterschiedlich aufgebauten Datenkanal-Zeile.

[Sproket_1972]

Hallo schönen Abend,
es gibt in der Zeile Datenkanal: auch leere Positionen !
Habe nicht verstanden was ich vergessen haben soll !
Die Zeile habe ich nochmal mit dem Original verglichen und sind bis auf die
Buchstaben in der Zeile  (die habe ich geändert) gleich.

Wenn der Code durchläuft dann wird In der Schleife alles in die Tabelle: Datenkanal
geschrieben.
Bis die Schleife verlassen werden soll, dann ist die Fehlermeldung da.

Bei direkter Antwort sind komplette Zitate überflüssig, verlängern nur unnötig das Thema. Zitat daher gelöscht. MzKlMu

[Lachtaube]

Würden in dieser Zeile Betriebsgeheimnisse stehen, hätte ich ja Verständnis für das Zurückhalten der Information.

Das Ratespiel geht weiter. Neuer Vorschlag

Code [Auswählen] Erweitern

Private Function ProcessDatenKanalLine(db As DAO.Database, l$)

   Const ERRMSG$ = "Fehler beim Verarbeiten der Datenkanalzeile"

   Dim s$(), i&, varr

   On Error GoTo 1

   s = Split(l, SEPARATOR)
   ReDim varr(UBound(s))
   
   '// ist das auch im Original so  ?????
   
   s(2) = s(1)   '// 1. Eintrag tanzt aus der Reihe => korrigieren

   With db.OpenRecordset("DatenKanal", dbOpenTable)

      .Index = "unique_dk"

      For i = 2 To UBound(s) Step 4

         If Len(Trim$(s(i))) Then

            .Seek "=", Trim$(s(i))

            If .NoMatch Then

               .AddNew
               .Collect("DatenKanal") = Trim$(s(i))
               .Update

               .Bookmark = .LastModified
               varr(i) = .Collect("DatenKanalId")

            Else

               varr(i) = .Collect("DatenKanalId")

            End If

         End If

      Next

      .Close

   End With

   ProcessDatenKanalLine = varr

   Exit Function

1
   Err.Raise vbObjectError + &H3, "mdlImport.ProcessDatenKanalLine", ERRMSG

End Function
Es wird dann nur importiert, was auch eine Eintragung im Datenkanal hat.

Code [Auswählen] Erweitern

Private Sub ProcessLine(rs As DAO.Recordset, id&, arr, l$)

   Dim s$(), dt, i&

   On Error GoTo 1
   s = Split(l, SEPARATOR)
   dt = CDate(s(0) & " " & s(1))

   For i = 2 To UBound(s) Step 4

      If Len(Nz(arr(i))) Then

         rs.AddNew
         rs.Collect("KundenId") = id
         rs.Collect("DatenKanalId") = arr(i)
         rs.Collect("Zeitpunkt") = dt
         rs.Collect("Wert") = CDbl(s(i))
         rs.Collect("Status") = IIf(Len(Trim$(s(i + 1))) = 1, Trim$(s(i + 1)), Null)
         rs.Update

      End If

   Next
1
End Sub

[Sproket_1972]

Hallo zusammen,
habe was gefunden !!
Wenn ich die Daten der Orginal-Datei  in die Test5 Datei kopiere dann,
ja dann, funktioniert der Code von Lachtaube ?
Warum den dass ??

Ich vermute eher, dass Du das Beispiel in der Zeile Datenkanal: beim Editieren vergeigt hast - prüfen musst Du das selbst. Oder gibt es auch leere Positionen in der Zeile?

Und noch einmal: anhand von Screenshots kann ich Dir nicht helfen. Der Fehler liegt vermutlich in einer unterschiedlich aufgebauten Datenkanal-Zeile.

[Sproket_1972]

 

ES FUNZT !!!!
Das war der Durchbruch !!
DANKE FÜR DIE UNTERSTÜTZUNG !!

[Sproket_1972]

Moin Moin,
schöne Grüße aus der Spätschicht.
Habe ein Frage zu dem Programm.
Das Programm läuft super, nur muss ich jetzt eine Erweiterung machen.
Es soll ein Formular aus der Zeit 6:00 Uhr von gestern bis 6:00 Uhr von Heute erstellt werden.
Die einzelnen Datensätze sind immer die selben und sollen in das Formular übernommen werden.
Es sollen dann die einzelnen Datensätze angeordnet werden.
Wenn das Formular erstellt ist dann soll es als Excel Datei exportierbar sein.
Frage: Wie bekomme ich es hin das ich einen Abfrage Assistenten einbaue wo ich die Anfangszeit(6:00 gestern) und Endzeit(6:00 Uhr heute) für das neue Formular einstellen kann ?
Wie kann ich einen Schalter (Button) bauen der mir aus dem neuen Formular eine Excel Datei erzeugt ?

Grüße aus der Spätschicht !

[Lachtaube]

Macht es einen Unterschied für die Bestimmung des Datums, den Export morgens um 4 Uhr oder um 7 Uhr anzuleiern?

Im Prinzip muss nur ein Datum für ein Abfragekriterium erfragt (eingegeben) werden, welches Deine Daten einschränkt. Dabei gilt: [DeinZeitfeld] >= [Datumskriterium] + #06:00:00# Und [DeinZeitfeld] < [Datumskriterium] + 1 + #06:00:00#
Das Kriterium kann dann entweder als Formularparameter in einer gespeicherten Abfrage oder als Funktion verankert werden. Mit DoCmd.Transferspreadsheet ließe sich anschließend ein Excel-Export anstoßen.

[Sproket_1972]

Moin,
Habe jetzt erst das lesen können.
Es muss immer von 6:00 Uhr bis 6:00 Uhr also die 24 Stunden dazwischen in das Formular eingetragen werden.
Ich brauche also ein Zeitfeld als Eingabemaske in einer Abfrage oder ?
Werde mal schauen ob ich das in einer Abfrage einbauen kann ?

Melde mich wieder !!
Gruß Helmut

[Lachtaube]

Helmut, Du musst nur ein Datum als Parameter festlegen, zu dem dann für den unteren Grenzwert 6 Stunden bzw. für den oberen Grenzwert 1 Tag + 6 Stunden hinzuaddiert werden (genauso wie in meiner skizzenhaften Erklärung in vorherigen Beitrag).

[Sproket_1972]

Moin Moin,
habe es verssucht aber leider ohne Erfolg.
Wenn ich unter Kriterium das eingeben dann wird leider kein Datensatz angezeigt.
kann man das ganze nicht in die VBA Abfrage einbauen die du mir damals zusammen gestellt hast.

Code [Auswählen] Erweitern

Public Sub ImportCSV_1()
Const ZielTab = "Zaehlerstaende"
     Dim i As Integer
     Dim AktDatei As String
     Dim TxtDatum As String
    ' Dim f%, l$, GotHdr As Boolean, rs As DAO.Recordset
     Const FILENAME$ = "\test3.csv"
     Const HDRLINE$ = "Datum;"
     'Const NOHDR$ = "Keine Überschriftenzeile gefunden"
     Const SuchVerzeichnis$ = "I:\ORG\OPOTSS\Dispatching\Zaehlerstaende_Epe\"
     
'Datum in Text umwandeln
     Debug.Print TxtDatum
     Datum = Str(Date)
     Debug.Print Datum
     Datum = Format(Date, "yyyymmdd") ' heutiges Datum als Text z.B.: 20160622
     Debug.Print Datum
     DatTyp = ("Test*" & Datum & ".csv")
     
     AktDatei$ = Dir(SuchVerzeichnis & "\" & DatTyp)
     'CurrentDb.Execute "DELETE * FROM Gastag_Gesamt" ' lösche der Daten in Tabelle: Gastag_Gesamt
   'Const FILENAME$ = "\test5.csv"

   Const KUNDENLINE$ = "Kundenname:;"
   Const DATENKANALLINE$ = "Datenkanal:;"
  ' Const HDRLINE$ = "Datum;"

   Const NOHDR$ = "Keine Überschriftenzeile gefunden"

   Dim f%, kid&, kdarr, l$, GotHdr As Boolean
   Dim db As DAO.Database, rs As DAO.Recordset

   On Error GoTo 1

   f = FreeFile()
   Open SuchVerzeichnis & AktDatei For Input As #f
   'Open CurrentProject.Path & FILENAME For Input As #f

   Set db = CurrentDb()

   Do Until EOF(f) Or GotHdr
      Line Input #f, l
      If Left$(l, 12) = KUNDENLINE Then kid = ProcessKundenLine(db, l)
      If Left$(l, 12) = DATENKANALLINE Then kdarr = ProcessDatenKanalLine(db, l)
      GotHdr = Left$(l, 6) = HDRLINE
   Loop

   If Not GotHdr Then

      MsgBox NOHDR

   Else
      Set rs = CurrentDb().OpenRecordset("AbleseDaten", dbOpenTable)

      Do Until EOF(f)
         Line Input #f, l
         Call ProcessLine(rs, kid, kdarr, l)
      Loop

      rs.Close

   End If

0
   Close #f

   Exit Sub

1
   MsgBox Err.Description & vbCrLf & vbCrLf & "Fehler-Nr.: " & Err.Number, _
          vbExclamation, "CSV-Import Fehler"
   Resume 0
End Sub

Private Sub ProcessLine(rs As DAO.Recordset, id&, arr, l$)

   Dim s$(), dt, i&

   On Error GoTo 1
   s = Split(l, SEPARATOR)
   dt = CDate(s(0) & " " & s(1))

   For i = 2 To UBound(s) Step 4

      If Len(Nz(arr(i))) Then

         rs.AddNew
         rs.Collect("KundenId") = id
         rs.Collect("DatenKanalId") = arr(i)
         rs.Collect("Zeitpunkt") = dt
         rs.Collect("Wert") = CDbl(s(i))
         rs.Collect("Status") = IIf(Len(Trim$(s(i + 1))) = 1, Trim$(s(i + 1)), Null)
         rs.Update

      End If

   Next
1
End Sub

Private Function ProcessKundenLine(db As DAO.Database, l$)
   Const ERRMSG1$ = "Es befinden sich keine Kundendaten in der Datei"
   Const ERRMSG2$ = "Fehler beim Verarbeiten des Kundennamen"

   Const SELQRY$ = _
         "SELECT KundenId, KundenName, KundenVorname" & _
         "  FROM Kunde WHERE KundenName = [@KundenName];"

   Dim s$(), k$

   On Error GoTo 1

   s = Split(l, SEPARATOR)
   k = Trim$(s(1))
   If Len(k) = 0 Then
      Err.Raise vbObjectError + &H1, "mdlImport.ProcessKundenLine", ERRMSG1
   End If

   With db.CreateQueryDef(vbNullString, SELQRY)
      .Parameters("@KundenName") = k

      With .OpenRecordset(dbOpenDynaset)

         If Not .EOF Then

            ProcessKundenLine = .Collect("KundenId")

         Else

            .AddNew
            .Collect("KundenName") = k
            .Update

            .Bookmark = .LastModified
            ProcessKundenLine = .Collect("KundenId")

         End If

         .Close

      End With

   End With

   Exit Function

1
   Err.Raise vbObjectError + &H2, "mdlImport.ProcessKundenLine", ERRMSG2

End Function



Private Function ProcessDatenKanalLine(db As DAO.Database, l$)

   Const ERRMSG$ = "Fehler beim Verarbeiten der Datenkanalzeile"

   Dim s$(), i&, varr

   On Error GoTo 1

   s = Split(l, SEPARATOR)
   ReDim varr(UBound(s))
   
   '// ist das auch im Original so  ?????
   
   s(2) = s(1)   '// 1. Eintrag tanzt aus der Reihe => korrigieren

   With db.OpenRecordset("DatenKanal", dbOpenTable)

      .Index = "unique_dk"

      For i = 2 To UBound(s) Step 4

         If Len(Trim$(s(i))) Then

            .Seek "=", Trim$(s(i))

            If .NoMatch Then

               .AddNew
               .Collect("DatenKanal") = Trim$(s(i))
               .Update

               .Bookmark = .LastModified
               varr(i) = .Collect("DatenKanalId")

            Else

               varr(i) = .Collect("DatenKanalId")

            End If

         End If

      Next

      .Close

   End With

   ProcessDatenKanalLine = varr

   Exit Function

1
   Err.Raise vbObjectError + &H3, "mdlImport.ProcessDatenKanalLine", ERRMSG

End Function