Office: Import aus Ordner im Format JJJJ.MM. und Dateiname JJJJ.MM.T

Hallo zusammen,

ich habe folgendes Problem:
Ich möchte eine Datei mit der Bennung mit aktuellem Tagesdatum bsp. 20120425.txt eines Ordners bsp 201204 importieren und lasse dann ein makro drüberlaufen.

Nun ist es so, dass die Datei jeden Tag bzw jeden Monat anders benannt sind.
Es soll immer die aktuellste Datei verwendet werden.
Jedoch sind die anderen Ordner und Daten noch vorhanden.
Ich bin mit meinem Latein am Ende
Wie kann ich dies lösen?

Ich beginne folgendermaßen:
Private Sub Workbook_Open()

Call konvertieren
Application.OnTime Now + TimeValue("00:00:10"), "close_doc"

End Sub

Dann rufe ich Modul1 wie folgt auf:

Sub konvertieren()

'

'
Workbooks.OpenText Filename:="C:\Users\JoRa\Desktop\test.txt", Origin:= _
xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote _
, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:= _
False, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1) _
, Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), _
Array(10, 1)), TrailingMinusNumbers:=True
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:="C:\Users\JoRa\Desktop\test.csv", FileFormat:=xlCSV, CreateBackup:=False
Application.DisplayAlerts = True



End Sub


Bitte um Hilfe.

Schon jetzt recht herzlichen Dank.

Gruß Joachim

 

Hallo Joachim,

Wenn die aktuellste = die heutige ist, dann kannst Du es mal hiermit probieren (den Pfad musst Du natürlich noch anpassen):

Code:

Option Explicit

Dim strPfad As String
Dim strOrdner As String
Dim strDateiname As String


Public Sub konvertieren()

strPfad = "C:\Users\JoRa\Desktop\"

If Month(Now) < 10 Then
    strOrdner = Year(Now) & "0" & Month(Now)
Else
    strOrdner = Year(Now) & Month(Now)
End If

If Day(Now) < 10 Then
    strDateiname = strOrdner & "0" & Day(Now)
Else
    strDateiname = strOrdner & Day(Now)
End If
    
' Prüfung ob Monatsordner vorhanden ist, ansonsten Abbruch
    If Dir(strPfad & strOrdner, vbDirectory) = "" Then
        MsgBox "Der gewünschte Monatsordner konnte nicht gefunden werden.", vbCritical, "Abbruch"
        Exit Sub
    End If
    
' wenn die gesuchte Datei im gewünschten Ordner vorhanden ist > öffnen, ansonsten Abbruch
    If Dir(strPfad & strOrdner & "\" & strDateiname & ".txt") = "" Then
        MsgBox "Die gewünschte Datei konnte nicht gefunden werden.", vbCritical, "Abbruch"
        Exit Sub
    Else
        Workbooks.OpenText Filename:=strPfad & strOrdner & "\" & strDateiname & ".txt", Origin:= _
            xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote _
            , ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:= _
            False, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1) _
            , Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), _
            Array(10, 1)), TrailingMinusNumbers:=True
        Application.DisplayAlerts = False
        ActiveWorkbook.SaveAs Filename:=strPfad & strOrdner & "\" & strDateiname & ".csv", FileFormat:=xlCSV, CreateBackup:=False
        Application.DisplayAlerts = True
    End If

End Sub

Wenn die aktuellste nicht immer die heutige ist, müsste man noch mittels Schleife den aktuellsten Ordner, und darin die aktuellste Datei ermitteln.

Alternativ könnte man das Datum bzw. den Dateinamen auch mittels InputBox manuell eingeben.

Und falls die aufrufende Datei in einem Überordner der Monatsordner ist, könnte man anstatt der Variablen "strPfad" einen festen Wert im Code zuzuordnen, auch mit "ThisWorkbook.Path" arbeiten.


Ich hoffe geholfen zu haben.