Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1260to1264
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Import aus Ordner im Format JJJJ.MM. und Dateiname

Import aus Ordner im Format JJJJ.MM. und Dateiname
jora74
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
AW: Import aus Ordner im Format JJJJ.MM. und Dateiname
01.05.2012 19:26:15
Josef

Hallo Joachim,
teste mal.
Sub konvertieren()
  Dim strPath As String, strDir As String, strFile As String
  Dim intDay As Integer
  Dim lngCalc As Long
  Dim bolSucceed As Boolean
  
  On Error GoTo ErrExit
  
  With Application
    .ScreenUpdating = False
    .EnableEvents = False
    lngCalc = .Calculation
    .Calculation = xlCalculationManual
    .DisplayAlerts = False
  End With
  
  strPath = "C:\Users\JoRa\Desktop" 'Stammverzeichnis - Anpassen
  
  strPath = IIf(Right(strPath, 1) = "\", strPath, strPath & "\")
  
  strDir = Format(Date, "yyyyMM") & "\" 'Monatsorder
  
  For intDay = Day(Date) To 1
    strFile = strPath & strDir & Format(DateSerial(Year(Date), Month(Date), intDay), "yyyyMMdd") & _
      ".txt"
    If Dir(strFile, vbNormal) <> "" Then
      Workbooks.OpenText Filename:=strFile, 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
      
      ActiveWorkbook.SaveAs Filename:=Replace(strFile, ".txt", ".csv"), FileFormat:=xlCSV, _
        CreateBackup:=False
      bolSucceed = True
      Exit For
    End If
  Next
  
  If Not bolSucceed Then
    MsgBox "Keine Datei gefunden!", vbInformation, "Hinweis"
  End If
  
  ErrExit:
  
  With Err
    If .Number <> 0 Then
      MsgBox "Fehler in Prozedur:" & vbTab & "'konvertieren'" & vbLf & String(60, "_") & _
        vbLf & vbLf & IIf(Erl, "Fehler in Zeile:" & vbTab & Erl & vbLf & vbLf, "") & _
        "Fehlernummer:" & vbTab & .Number & vbLf & vbLf & "Beschreibung:" & vbTab & _
        .Description & vbLf, vbExclamation + vbMsgBoxSetForeground, _
        "VBA - Fehler in Modul - Modul1"
      .Clear
    End If
  End With
  
  On Error GoTo 0
  
  With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = lngCalc
    .DisplayAlerts = True
  End With
  
End Sub



« Gruß Sepp »

Anzeige
AW: Import aus Ordner im Format JJJJ.MM. und Dateiname
01.05.2012 20:21:41
jora74
Hallo Sepp,
danke für deine schnelle, super Antwort.
Die erste Version ist schon perfekt.
Ich bekomme jeden Tag diese Datei.
Ist ein Logfile, und wird ständig um Werte ergänzt.
Diese möchte ich nun in zeitlichen Abständen in eine Datenbank schreiben,
deshalb das csv Format.
Wäre es auch möglich die CSV Datei mit Semikolon auszugeben?
Gruß Joachim
AW: Import aus Ordner im Format JJJJ.MM. und Dateiname
01.05.2012 20:24:39
jora74
Nachtrag, hatte ich noch vergessen.
Ganz wichtig die Ausgabedatei soll immer den gleichen Namen haben und immer im gleichen
Verzeichnis liegen.
Bsp. c:\test\test.txt
Falls die alte Datei noch vorhanden soll diese ohne weiteres einfach überschrieben werden.
Dank gruß Joachim
Anzeige
AW: Import aus Ordner im Format JJJJ.MM. und Dateiname
01.05.2012 21:26:23
Josef

Hallo Joachim,
xl ist beim erstellen der csv oft störrisch, ich mach das meist so.
' **********************************************************************
' Modul: Modul5 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub konvertieren()
  Dim strPath As String, strDir As String, strFile As String
  Dim intDay As Integer
  Dim lngCalc As Long
  Dim bolSucceed As Boolean
  
  Const cstrOutPut As String = "E:\Temp\Test\test.csv" '"C:\Test\test.csv" 'Ausgabedatei
  
  On Error GoTo ErrExit
  
  With Application
    .ScreenUpdating = False
    .EnableEvents = False
    lngCalc = .Calculation
    .Calculation = xlCalculationManual
    .DisplayAlerts = False
  End With
  
  
  strPath = "E:\Temp\test" '"C:\Users\JoRa\Desktop" 'Stammverzeichnis - Anpassen
  
  strPath = IIf(Right(strPath, 1) = "\", strPath, strPath & "\")
  
  strDir = Format(Date, "yyyyMM") & "\" 'Monatsorder
  
  For intDay = Day(Date) To 1
    strFile = strPath & strDir & Format(DateSerial(Year(Date), Month(Date), intDay), "yyyyMMdd") & _
      ".txt"
    If Dir(strFile, vbNormal) <> "" Then
      Workbooks.OpenText FileName:=strFile, 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
      
      
      bolSucceed = saveRangeAsCSV(ActiveSheet.UsedRange, cstrOutPut) > -1
      Exit For
    End If
  Next
  
  If Not bolSucceed Then
    MsgBox "Keine Datei gefunden!", vbInformation, "Hinweis"
  Else
    MsgBox "Die Datei '" & cstrOutPut & "' wurde erfolgreich erstellt!", vbInformation, "Hinweis"
  End If
  
  ErrExit:
  
  With Err
    If .Number <> 0 Then
      MsgBox "Fehler in Prozedur:" & vbTab & "'konvertieren'" & vbLf & String(60, "_") & _
        vbLf & vbLf & IIf(Erl, "Fehler in Zeile:" & vbTab & Erl & vbLf & vbLf, "") & _
        "Fehlernummer:" & vbTab & .Number & vbLf & vbLf & "Beschreibung:" & vbTab & _
        .Description & vbLf, vbExclamation + vbMsgBoxSetForeground, _
        "VBA - Fehler in Modul - Modul1"
      .Clear
    End If
  End With
  
  On Error GoTo 0
  
  With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = lngCalc
    .DisplayAlerts = True
  End With
  
End Sub



Private Function saveRangeAsCSV(Target As Range, FileName As String, Optional Separator As String = ";") As Long
  Dim rngRow As Range, rng As Range
  Dim strTmp As String
  Dim FF As Integer
  
  saveRangeAsCSV = -1
  
  On Error GoTo ErrExit
  
  If Dir(FileName, vbNormal) <> "" Then Kill FileName
  
  FF = FreeFile
  Open FileName For Output As #FF
  For Each rngRow In Target.Rows
    strTmp = ""
    For Each rng In rngRow.Cells
      strTmp = strTmp & rng.Text & Separator
    Next
    strTmp = Left(strTmp, Len(strTmp) - 1)
    Print #FF, strTmp
  Next
  saveRangeAsCSV = FF
  ErrExit:
  Close #FF
  
End Function



« Gruß Sepp »

Anzeige
AW: Import aus Ordner im Format JJJJ.MM. und Dateiname
03.05.2012 12:55:29
Jora74
Hallo Sepp,
Ich habe mit deinem letzten Script Probleme.
Ich bekomme nun ständig die Meldung " Datei nicht gefunden "
Habe die Pfade angepasst.
Großes ?
Gruss Joachim
Pfad angepasst? o.T.
03.05.2012 17:24:41
Josef
« Gruß Sepp »

AW: Pfad angepasst? o.T.
03.05.2012 18:01:38
jora74
Hallo Sepp,
ich habe es wie unten geändert was mache ich falsch?
' **********************************************************************
' Modul: Modul5 Typ: Allgemeines Modul
Option Explicit
Sub konvertieren()
Dim strPath As String, strDir As String, strFile As String
Dim intDay As Integer
Dim lngCalc As Long
Dim bolSucceed As Boolean
Const cstrOutPut As String = "c:\Test\test.csv" '"C:\Test\test.csv" 'Ausgabedatei
On Error GoTo ErrExit
With Application
.ScreenUpdating = False
.EnableEvents = False
lngCalc = .Calculation
.Calculation = xlCalculationManual
.DisplayAlerts = False
End With
strPath = "C:\Users\JoRa\Desktop" '"C:\Users\JoRa\Desktop" 'Stammverzeichnis - Anpassen
strPath = IIf(Right(strPath, 1) = "\", strPath, strPath & "\")
strDir = Format(Date, "yyyyMM") & "\" 'Monatsorder
For intDay = Day(Date) To 1
strFile = strPath & strDir & Format(DateSerial(Year(Date), Month(Date), intDay), "yyyyMMdd") _
& _
".txt"
If Dir(strFile, vbNormal)  "" Then
Workbooks.OpenText FileName:=strFile, 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
bolSucceed = saveRangeAsCSV(ActiveSheet.UsedRange, cstrOutPut) > -1
Exit For
End If
Next
If Not bolSucceed Then
MsgBox "Keine Datei gefunden!", vbInformation, "Hinweis"
Else
MsgBox "Die Datei '" & cstrOutPut & "' wurde erfolgreich erstellt!", vbInformation, " _
Hinweis"
End If
ErrExit:
With Err
If .Number  0 Then
MsgBox "Fehler in Prozedur:" & vbTab & "'konvertieren'" & vbLf & String(60, "_") & _
vbLf & vbLf & IIf(Erl, "Fehler in Zeile:" & vbTab & Erl & vbLf & vbLf, "") & _
"Fehlernummer:" & vbTab & .Number & vbLf & vbLf & "Beschreibung:" & vbTab & _
.Description & vbLf, vbExclamation + vbMsgBoxSetForeground, _
"VBA - Fehler in Modul - Modul1"
.Clear
End If
End With
On Error GoTo 0
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = lngCalc
.DisplayAlerts = True
End With
End Sub
Private Function saveRangeAsCSV(Target As Range, FileName As String, Optional Separator As  _
String = ";") As Long
Dim rngRow As Range, rng As Range
Dim strTmp As String
Dim FF As Integer
saveRangeAsCSV = -1
On Error GoTo ErrExit
If Dir(FileName, vbNormal)  "" Then Kill FileName
FF = FreeFile
Open FileName For Output As #FF
For Each rngRow In Target.Rows
strTmp = ""
For Each rng In rngRow.Cells
strTmp = strTmp & rng.Text & Separator
Next
strTmp = Left(strTmp, Len(strTmp) - 1)
Print #FF, strTmp
Next
saveRangeAsCSV = FF
ErrExit:
Close #FF
End Function
gruß Joachim
Anzeige
AW: Pfad angepasst? o.T.
03.05.2012 18:49:00
Josef

Hallo Joachim,
ich schätze mal, das der generierte Dateiname nicht stimmt!

« Gruß Sepp »

AW: Pfad angepasst? o.T.
03.05.2012 19:17:49
Jora74
Hallo Sepp,
Die Datei heißt 20120503.txt
Gruß Joachim
AW: Pfad angepasst? o.T.
03.05.2012 21:23:31
Josef

Hallo Joachim,
und wie sieht es mit dem Pfad aus? Gehe den Code mal im Einzelschritt (F8) durch und schau mal, welchen Pfad und Dateinamen strFile ausgibt.

« Gruß Sepp »

Anzeige
AW: Pfad angepasst? o.T.
03.05.2012 21:42:38
jora74
Hallo Sepp,
es mir ja schon peinlich dich immer zu belästigen.
Also es steht bei mir:
strPath="C:\User\JoRa\Desktop\= wahr
strDir="201205\"
In dieser Zeile:
For intDay = Day(Date) To 1
strFile = strPath & strDir & Format(DateSerial(Year(Date), Month(Date), intDay), "yyyyMMdd") & _
".txt"
strFile=""StrPath="C:\Users\JoRa\Desktop\" & strDir="201205\" & nichts mehr
If Dir(strFile auch nichts mehr - d.h. strFile=""
AW: Pfad angepasst? o.T.
03.05.2012 21:49:49
Josef

Hallo Joachim,
was mir gerade aufgefallen ist, bei der Zeile
For intDay = Day(Date) To 1
ist was "verloren" gegangen;-))
Es muss so heißen.
For intDay = Day(Date) To 1 Step -1


« Gruß Sepp »

Anzeige
AW: Pfad angepasst? o.T.
03.05.2012 21:54:54
jora74
Hallo Sepp,
Yes !! Das war`s.
Es funktioniert wunderbar. Perfekt.
Du bist ein Genie - ein großes Lob an Dich.
Und ganz viele Dankeschön.
Wenn ich mal wieder ein Problem habe, darf ich mich dann wieder an Dich wenden;-)
Schönen Abend noch und viele Grüße
Joachim
AW: Pfad angepasst? o.T.
03.05.2012 22:21:06
Josef

Hallo Joachim,
freut mich, dass es klappt!
Natürlich kannst du bei Problemen fragen stellen, allerdings sind Anfragen die an eine bestimmte Person gerichtet sind oft ein Grund das andere darauf nicht reagieren, also besser einfach das Problem schildern, einer der Helfer wird sich schon drum kümmern.

« Gruß Sepp »

Anzeige
AW: Pfad angepasst? o.T.
04.05.2012 12:25:21
Jora74
So bin's nochmal. Habe eben gemerkt, dass in der csv kein ; ist.
Woran kann dies liegen?
Gruß Joachim
AW: Pfad angepasst? o.T.
04.05.2012 18:55:13
Josef

Hallo Joachim,
das liegt wohl an den Daten in deiner txt-Datei. Lade mal so ein Teil hoch.

« Gruß Sepp »

AW: Pfad angepasst? o.T.
04.05.2012 21:39:37
jora74
Hallo Sepp,
so nun endlich daheim.
Ich lad mal eine Datei hoch.
https://www.herber.de/bbs/user/80044.txt
Anzeige
AW: Pfad angepasst? o.T.
04.05.2012 21:58:45
Josef

Hallo Joachim,
zu deiner Beispieldatei passt dein Import-Code nicht, Trennzeichen ist nicht TAB sondern Leerzeichen!
Zeichne den Import nochmal auf und ändere die entsprechende(n) Stelle(n) im Code.

« Gruß Sepp »

andere Version
01.05.2012 20:05:51
Josef

Hallo Joachim,
hier eine andere version, falls nicht jeden Tage eine txt-Datei vorhanden ist.
Sub konvertieren()
  Dim strPath As String, strDir As String, strFile As String
  Dim intDay As Integer
  Dim lngCalc As Long
  Dim bolSucceed As Boolean
  
  Const MAX_DAYS_PAST As Long = 30 'Wie weit soll in der Vergangenheit gesucht werden (Tage)
  
  On Error GoTo ErrExit
  
  With Application
    .ScreenUpdating = False
    .EnableEvents = False
    lngCalc = .Calculation
    .Calculation = xlCalculationManual
    .DisplayAlerts = False
  End With
  
  strPath = "C:\Users\JoRa\Desktop" 'Stammverzeichnis - Anpassen
  
  strPath = IIf(Right(strPath, 1) = "\", strPath, strPath & "\")
  
  For intDay = 0 To MAX_DAYS_PAST
    strFile = strPath & Format(Date - intDay, "yyyyMM") & "\" & Format(Date - intDay, "yyyyMMdd") & ".txt"
    If Dir(strFile, vbNormal) <> "" And Dir(Replace$(strFile, ".txt", ".csv"), vbNormal) = "" Then
      Workbooks.OpenText Filename:=strFile, 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
      
      ActiveWorkbook.SaveAs Filename:=Replace$(strFile, ".txt", ".csv"), FileFormat:=xlCSV, _
        CreateBackup:=False
      bolSucceed = True
      Exit For
    End If
  Next
  
  If Not bolSucceed Then
    MsgBox "Keine Datei gefunden!", vbInformation, "Hinweis"
  End If
  
  ErrExit:
  
  With Err
    If .Number <> 0 Then
      MsgBox "Fehler in Prozedur:" & vbTab & "'konvertieren'" & vbLf & String(60, "_") & vbLf & vbLf _
        & IIf(Erl, "Fehler in Zeile:" & vbTab & Erl & vbLf & vbLf, "") & "Fehlernummer:" & vbTab & _
        .Number & vbLf & vbLf & "Beschreibung:" & vbTab & .Description & vbLf, vbExclamation + _
        vbMsgBoxSetForeground, "VBA - Fehler in Modul - Modul1"
      .Clear
    End If
  End With
  
  On Error GoTo 0
  
  With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = lngCalc
    .DisplayAlerts = True
  End With
  
End Sub



« Gruß Sepp »

Anzeige
AW: andere Version
02.05.2012 23:17:59
jora74
Hallo Sepp,
bin leider noch nicht dazu gekommen werde ich aber morgen gleich nachholen.
Vielleicht habe ich noch die eine oder andere Frage.
Trotzdem schon recht herzlichen Dank.
Gruß
Joachim

304 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige