Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1668to1672
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

Textdateien Laden

Textdateien Laden
17.01.2019 17:56:21
Matze
Hallo Profis,
Ich habe einen code erhalten
Dieser

Sub ermöglicht es Textdateien in Excel als ein Worksheet einzulesen.
Der code gibt dem Worksheet den Namen der eingelesenen Textdatei.
Durch die Schleife ist es möglich mehrere Dateien auszuwählen und zu laden.
Problem bei dem Code ist, das wenn eine bereits geladene Datein erneut geladen wird,
ergibt das einen Laufzeitfehler 1004, da dann 2 sheets den selben Namen hätten.
Meine Aufgabe ist es eine funktion hinzuzufügen:
Es soll beim laden ermittelt werden welche dateien schon geöffnet sind,
falls die Datein schon geladen ist soll der Ladevorgang abgebrochen werden.
Der Code sieht bisher so aus:
'loads multiple data files in excel

Sub LoadData()
With Application.FileDialog(msoFileDialogFilePicker)
.Show
AnzahlDatein = .SelectedItems.Count
'cancel, after selection is zero
If .SelectedItems.Count = 0 Then
MsgBox "cancel"
Exit Sub
End If
fStr = .SelectedItems(1)
End With
'open all files
counter = 1
Do While counter  AnzahlDatein + 1
fStr = Application.FileDialog(msoFileDialogFilePicker).SelectedItems(counter)
'find out the name of the file
i = 1
Dateiname = Right(fStr, i)
Zeichen = Left(Dateiname, 1)
Do While Zeichen  "\"
Zeichen = Left(Right(fStr, i), 1)
i = i + 1
Loop
'open file
Dateiname = Right(fStr, i - 2)
Sheets("Speicher").Select
With ThisWorkbook.Sheets("Speicher").QueryTables.Add(Connection:= _
"TEXT;" & fStr, Destination:=Range("$A$1"))
.Name = "CAPTURE"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
'copy data and place in new sheet
Cells.Select
Selection.Cut
Sheets.Add
Cells.Select
ActiveSheet.Paste
Cells(1, 4) = Dateiname
'Change name [] to ()
Range("B1").Select
Cells.Find(What:="[", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate
ActiveCell.Replace What:="[", Replacement:="(", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Cells.FindNext(After:=ActiveCell).Activate
Range("B1").Select
Cells.Find(What:="]", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate
ActiveCell.Replace What:="]", Replacement:=")", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Cells.FindNext(After:=ActiveCell).Activate
'use name as Sheetname
For X = 1 To Sheets.Count
If Worksheets(X).Range("D1").Value  "" Then
Sheets(X).Name = Worksheets(X).Range("D1").Value
End If
Next
'increment counter for opening all files
counter = counter + 1
Loop
Sheets("Berechnung").Select
End Sub
Könnt Ihr mir helfen?

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige