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.
So sieht der Code derzeit aus:
Sub
LoadData()
With
Application.FileDialog(msoFileDialogFilePicker)
.Show
AnzahlDatein = .SelectedItems.Count
If
.SelectedItems.Count = 0
Then
MsgBox
"cancel"
Exit
Sub
End
If
fStr = .SelectedItems(1)
End
With
counter = 1
Do
While
counter <> AnzahlDatein + 1
fStr = Application.FileDialog(msoFileDialogFilePicker).SelectedItems(counter)
i = 1
Dateiname = Right(fStr, i)
Zeichen = Left(Dateiname, 1)
Do
While
Zeichen <> "\"
Zeichen = Left(Right(fStr, i), 1)
i = i + 1
Loop
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
Cells.
Select
Selection.Cut
Sheets.Add
Cells.
Select
ActiveSheet.Paste
Cells(1, 4) = Dateiname
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
For
X = 1
To
Sheets.Count
If
Worksheets(X).Range(
"D1"
).Value <>
""
Then
Sheets(X).Name = Worksheets(X).Range(
"D1"
).Value
End
If
Next
counter = counter + 1
Loop
Sheets(
"Berechnung"
).
Select
End
Sub