Office: Automatischer Import der aktuellsten CSV

Hallo,

Als erstes möchte ich mich bei Euch bedanken das Ihr solchen DAUs wie mich mit Euren Fachwissen unterstützt. Danke.

Wie Ihr Euch bei dieser Einleitung sicherlich denken könnt hab ich von Makros keine Ahnung, wie ich immer wieder mal gerne untere Beweise stelle ;-). Auch meine allgemeine Excel Kenntnisse sind begrenzt.

Daher bitte ich Euch um Nachsicht. Danke.

Ich habe mal mein Ziel in 2 Phasen unterteilt. Ich erhoffe mir davon das ich es durch einfacher habe beim erstellen wie auch um die Sache besser zu verstehen.

Hintergrund um Euch besser mitzunehmen ist folgender.
Ich habe hier einen Datenlogger der mir, wenn gestartet, kontinuierlich in eine CSV die Daten ablegt.
Diese möchte ich „Life“ in einen Diagram verarbeiten bzw darstellen.

Hmm jetzt wo ich das schreibe fällt mir gerade ein das ich garnicht weiss ob der Datenlogger die CSV konstant auf hat und nur zwischen speichert oder ob er sie jedesmal öffnet und speichert…..
Kann man auch CSV Dateien automatisch importieren die schon von einen anderen Programm geöffnet ist?
Also quasi Schreibgeschützt?


Phase 1.
Es soll das Aktuellste CSV aus einem Ordner importiert werden.
- Der Ordner liegt im gleichen Ordner wie die ziel Excel Datei
- Der Ordner heißt Log
- Das Arbeitsblatt Rohdaten
- Im Ordner können mehrere CSV liegen. Daher soll immer nur das Aktuellste importiert werden
- Trennzeichen ist ein Semikolon
- hier mal ein Beispiel der Namensgebung der CSV 20220705_134943.csv 20220705_134943.csv

Mein Versuch sah so aus

Code:

Sub Import_Latest_CSV()
    Dim FolderPath As String
    Dim Filename As String
    Dim LatestFile As String
    Dim LatestDate As Date
    Dim MyFile As Variant
  
    FolderPath = ActiveWorkbook.path & "\Log\"
  
    Filename = Dir(FolderPath & "*.csv")
    If Filename <> "" Then
        Do While Filename <> ""
            'Extrahieren Sie das Datum aus dem Dateinamen
            Dim dateString As String
            dateString = Left(Filename, 8)
            Dim year As Integer
            year = Left(dateString, 4)
            Dim month As Integer
            month = Mid(dateString, 5, 2)
            Dim day As Integer
            day = Right(dateString, 2)
            Dim hour As Integer
            hour = Mid(Filename, 10, 2)
            Dim minute As Integer
            minute = Mid(Filename, 12, 2)
            Dim second As Integer
            second = Mid(Filename, 14, 2)
          
            Dim fileDate As Date
            fileDate = DateSerial(year, month, day) + TimeSerial(hour, minute, second)
          
            If fileDate > LatestDate Then
                LatestFile = Filename
                LatestDate = fileDate
            End If
            Filename = Dir
        Loop
    End If
  
    If LatestFile <> "" Then
        With ThisWorkbook.Sheets("Rohdaten").QueryTables.Add(Connection:= _
            "TEXT;" & FolderPath & LatestFile, Destination:= _
            ThisWorkbook.Sheets("Rohdaten").Range("A1"))
            .Name = LatestFile
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .TextFilePromptOnRefresh = False
            .TextFilePlatform = 850
            .TextFileStartRow = 1
            .TextFileParseType = xlDelimited
            .TextFileTextQualifier = xlTextQualifierDoubleQuote
            .TextFileConsecutiveDelimiter = False
            .TextFileSemicolonDelimiter = True
            .TextFileTabDelimiter = False
            .TextFileCommaDelimiter = False
            .TextFileSpaceDelimiter = False
            .TextFileOtherDelimiter = ";"
            .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
        1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 _
        , 1, 1, 1, 1, 1, 1, 1, 1, 1)
            .TextFileTrailingMinusNumbers = True
            .Refresh BackgroundQuery:=False
        End With
    End If
End Sub

Ich bekomme Hier zwar keine Fehler Meldung allerdings importiert er auch nicht die CSV. Wo liegt der Fehler?



Phase 2

- hier soll im Arbeitsblatt Rohdaten vor dem Import der Inhalt gelöscht werden. Ich möchte damit vermeiden das evtl alt Daten die Weiterverarbeitung behindern

- der Import soll alle x Minuten stattfinden. Hier bin ich mir noch nicht sicher wie sinnvoll es ist das direkt zu integrieren oder ein separaten Makro der den Import Makro aktiviert zu schreiben. Mit stopp Knopf.

- automatisches aktualisieren der Diagramme.





Für alle Anregungen, Tipps, Tricks und Hilfen bin ich Euch sehr Dankbar.





Gruß

Markus

 

Hallo

Frage mich immer wieder warum sollte es VBA unbedingt sein?
Hier reicht doch Power Query, dies ist ohne VBA.
Oder habe ich was überlesen?

 

Hmm da scheint wieder mein DAU Status durch zu scheinen^^
das soll also mit Power Query gehen? Muss ich mir mal ansehen was das überhaupt ist bzw wie.
Bzw hast Du eine Idee wie?

Danke

 

Hallo

Klar geht das!
Siehe Datei, eventuell noch nach belieben im PQ Editor bearbeiten.

 

Hallo
Hatte noch einen kleinen Fehler entdeckt, hier die neue Ausfertigung

 

Datenlogger ? Welcher?
Also wenn es einer von Testo ist ,dann könnte das mittels spezieller Software gehen. Für die Datenlogger gibt es einen Treiber ,der es ermöglicht die Daten ins Excel zu bekommen. Ein usbtreiber ,der eine virtuellen Comport erzeugt. Mit diesem kann das Datastreamer Addin dann die Daten live ins Arbeitsblatt holen. Bin mir aber nicht sicher, da mein Meßgerät das leider nicht unterstützt hat.