Zeile aus einer txt Datei kopieren

Sub Abfrage() ChDir "C:\import_20130928\CR_60" Workbooks.OpenText Filename:= _ "C:\import_20130728\XX_60\Standard XX_60__2013-07-28_04-11-23__Seg.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), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), _ Array(15 _ , 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1), Array(21, 1) _ _ _ , _ Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), Array(27, 1), _ Array( _ 28, 1)), TrailingMinusNumbers:=True Range("A1").Select Range(Selection, Selection.End(xlToRight)).Select Application.CutCopyMode = False Selection.Copy ActiveWindow.Close Range("A1").Select ActiveSheet.Paste End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Abfrage() Dim datDatum As Date, strDatei As String, strOrdner As String Dim fsObj As Object, fsSubFolder As Object, fsFolder As Object Dim fsFile As Variant Dim intSpalte As Integer, arrFieldInfo() As Integer Dim rngZiel As Range Dim strFileLike As String datDatum = Date 'aktuelles/heutiges Datum 'Suchmuster für Dateiname ? = beliebiges Zeichen, # = beliebige Ziffer strFileLike = "Standard ?_60__" & Format(datDatum, "YYYY-MM-DD") & "_##-##-##__Seg.txt" 'Startordner für Dateisuche strOrdner = "C:\import_" & Format(datDatum, "YYYYMMDD") Set fsObj = VBA.CreateObject("Scripting.FileSystemObject") Set fsFolder = fsObj.GetFolder(strOrdner) Set fsSubFolder = fsFolder.subfolders 'Ordner in Unterordner suchen - For Each fsFolder In fsSubFolder If fsFolder.Name Like "?_60" Then 'Dateinamen im Ordner mit Suchmuster vergleichen For Each fsFile In fsFolder.Files If fsFile.Name Like strFileLike Then strDatei = fsFile.Path Exit For End If Next End If Next If strDatei "" Then Set rngZiel = ActiveSheet.Range("A1") 'Zielzelle für Einfügen der Daten 'FieldInfo für Import vorbereiten ReDim arrFieldInfo(1 To 27, 1 To 2) For intSpalte = 1 To 27 arrFieldInfo(intSpalte, 1) = intSpalte arrFieldInfo(intSpalte, 2) = 1 'als Standard/allgemein einlesen Next 'Textdatei öffnen Workbooks.OpenText Filename:=strDatei, _ Origin:=xlMSDOS, StartRow:=1, DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _ Semicolon:=False, Comma:=False, Space:=False, Other:=False, _ FieldInfo:=arrFieldInfo, TrailingMinusNumbers:=True Erase arrFieldInfo 'Daten aus erster Zeile kopieren With ActiveSheet .Range(.Cells(1, 1), .Cells(1, .Columns.Count).End(xlToRight)).Copy _ Destination:=rngZiel End With 'Textdatei wieder schließen ActiveWindow.Close Else MsgBox "Datei """ & strFileLike & """ nicht gefunden!" End If 'Objektvariablen zurücksetzen Set rngZiel = Nothing Set fsObj = Nothing: Set fsFolder = Nothing: Set fsFile = Nothing End Sub

Hallo Rocio,
du schreibst in deiner Frage, dass dein anderes Programm jeden Tag einen Ordner
"C:\import_JJJJMMTT" und die dazugehörigen Daten anlegt.
Das heißt: Heute müsste der Ordner "C:\import_20131001" angelegt worden sein mit den Daten vom 30.09.2013.
Wenn das nicht der Fall ist dann kann Excel nichts finden und in diesem Fall kommt es zum Fehler.
Irgendetwas scheint also nicht so zu sein, wie in deiner Frage beschrieben.
Nachfolgend das Makro modifiziert. Du kannst das Datum in der Inputbox ändern und nach einem Fehler erfolgt eine entsprechende Meldung ohne das der Debugger startet.
Gruß
Franz

Sub Abfrage()
Dim datDatum As Date, strDatei As String, strOrdner As String
Dim fsObj As Object, fsSubFolder As Object, fsFolder As Object
Dim fsFile As Variant
Dim intSpalte As Integer, arrFieldInfo() As Integer
Dim rngZiel As Range
Dim strFileLike As String
On Error GoTo Fehler
strDatei = InputBox("Bitte Datum des Ordners eingeben aus dem importiert werden soll.", _
"Makro Abfrage", Default:=Date) ' Vorgabe = aktuelles/heutiges Datum
If strDatei = "" Then Exit Sub 'Abbrechen wurde gewählt
If IsDate(strDatei) Then
datDatum = CDate(strDatei)
Else
MsgBox "Eingabe """ & strDatei & """ ist kein gültiges Datum!", , _
"Makro Abfrage - A B B R U C H !"
GoTo Fehler
End If
'Suchmuster für Dateiname ? = beliebiges Zeichen, # = beliebige Ziffer
strFileLike = "Standard ?_60__" & Format(datDatum, "YYYY-MM-DD") & "_##-##-##__Seg.txt"
'Startordner für Dateisuche
strOrdner = "C:\import_" & Format(datDatum, "YYYYMMDD")
Set fsObj = VBA.CreateObject("Scripting.FileSystemObject")
Set fsFolder = fsObj.GetFolder(strOrdner)
Set fsSubFolder = fsFolder.subfolders
'Ordner in Unterordner suchen  -
For Each fsFolder In fsSubFolder
If fsFolder.Name Like "?_60" Then
'Dateinamen im Ordner mit Suchmuster vergleichen
For Each fsFile In fsFolder.Files
If fsFile.Name Like strFileLike Then
strDatei = fsFile.Path
Exit For
End If
Next
End If
Next
If strDatei  "" Then
Set rngZiel = ActiveSheet.Range("A1") 'Zielzelle für Einfügen der Daten
'FieldInfo für Import vorbereiten
ReDim arrFieldInfo(1 To 27, 1 To 2)
For intSpalte = 1 To 27
arrFieldInfo(intSpalte, 1) = intSpalte
arrFieldInfo(intSpalte, 2) = 1 'als Standard/allgemein einlesen
Next
'Textdatei öffnen
Workbooks.OpenText Filename:=strDatei, _
Origin:=xlMSDOS, StartRow:=1, DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, _
FieldInfo:=arrFieldInfo, TrailingMinusNumbers:=True
Erase arrFieldInfo
'Daten aus erster Zeile kopieren
With ActiveSheet
.Range(.Cells(1, 1), .Cells(1, .Columns.Count).End(xlToRight)).Copy _
Destination:=rngZiel
End With
'Textdatei wieder schließen
ActiveWindow.Close
Else
MsgBox "Datei """ & strFileLike & """ nicht gefunden!"
End If
Fehler:
With Err
Select Case .Number
Case 0 'Alles OK
Case 76
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description & vbLf & vbLf _
& "Pfad: " & strOrdner, , "Makro: Abfrage"
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description, , "Makro: Abfrage"
End Select
End With
'Objektvariablen zurücksetzen
Set rngZiel = Nothing
Set fsObj = Nothing: Set fsFolder = Nothing: Set fsFile = Nothing
End Sub

Beliebteste Forumthreads (12 Monate)

Zeile aus einer txt Datei kopieren

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Zeile aus einer txt Datei kopieren

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread