parlermo2102
Goto Top

Alle CSV-Dateien mit neuem Datum in einem Ordner mit einem VBA Makro einlesen

Hallo ich habe ein Problem Mit Makro

ich möchte 2 CSV dateien per Makro einlesen
SetMontageExport-DGS-16-04-11.csv
SetMontageExport-NDGS-16-04-11.csv

wie bekomme ich das Makro dazu immer das Aktuellste Datum zu importieren ohne das ich die alten Dateien Löschen muss .

wenn ich die Dateien umbenenne geht das alles ohne Probleme
Range("A1").Select  
    With ActiveSheet.QueryTables.Add(Connection:="TEXT;C:\mtmp\DGS.csv", _  
        Destination:=Range("$A$1"))  
       
        .Name = "DGS"  
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 1252
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = True
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    Range("A33").Select  
    ActiveWindow.SmallScroll Down:=-15
    Range("A33").Select  
   Dim s As String
Dim i As Long
With ActiveSheet
    i = 3
    Do
        i = i + 1
        s = Cells(i, "A")  
        If Len(s) = 0 Then
            Cells(i, "A").Activate  
            Exit Do
        End If
    Loop While i < 65535
End With
freeRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
  With ActiveSheet.QueryTables.Add(Connection:="TEXT;C:\mtmp\NDGS.csv", _  
        Destination:=Range("A" & freeRow))  
        .Name = "NDGS"  
        .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 = 2
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = True
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With

[Edit Biber] Codeformatierung, sonst wird es wohl keiner lesen wollen. [/Edit]

Content-Key: 301507

Url: https://administrator.de/contentid/301507

Ausgedruckt am: 19.03.2024 um 11:03 Uhr

Mitglied: 114757
114757 11.04.2016 aktualisiert um 17:19:32 Uhr
Goto Top
Moin.
Die neueste Datei eines Ordners bekommst du so:
'Bestimmte Dateien eines Verzeichnisses in ein Recordset einlesen und Absteigend nach Datum sortieren  
Function getNewestFiles(strFolder,strEXT)
	Set objList = CreateObject("ADOR.Recordset")  
	Set fso = CreateObject("Scripting.Filesystemobject")  
	objList.Fields.Append "name", 200, 255  
	objList.Fields.Append "date", 7  
	objList.Open
	For Each file In fso.GetFolder(strFolder).Files
		If LCase(fso.GetExtensionName(file.Path)) = LCase(strEXT) Then
			objList.AddNew
			objList("name").Value = file.Path  
			objList("date").Value = file.DateLastModified  
			objList.Update
		End If
	Next
	objList.Sort = "date DESC"  
	Set getNewestFiles = objList
	Set fso = Nothing
	Set objList = Nothing
End Function

'Neueste Datei in Variable speichern  
strNewestFile = getNewestFiles("C:\mtmp","csv")("name").Value  
' und testweise ausgeben ...  
MsgBox strNewestFile

Zum Import von CSV-Dateien sage ich jetzt nichts mehr, dazu gibt es hier im Forum Threads bis zum abwinken ...

Gruß jodel32