Dialogfenster Dateiöffnüngsreihenfolge bestimmen
06.08.2015 13:26:19
Conelius
gibt es eine Möglichkeit die Reihenfolge der Dateiöffnung von den im Dialogfenster ausgewählten Dateien zu bestimmen?
D.h. es liegen jeweils drei Dateien vor mit unterschiedlichen Namen aber einem aufsteigenden Zählindex, wobei sich die Zahl immer an 9. letzten Stelle vom Dateinamen befindet z.B.:
Datei 1: Dateinamea_1_xyz.txt
Datei 2: Dateinameb_2_zyx.txt
Datei 3: Dateinamec_3_yzx.txt
Die Dateien sollen unabhängig von der Reihenfolge der Nutzerauswahl im Dialogfenster in der Reihenfole 1, 2, 3 geöffnet werden. Gibt es dafür eine Möglichkeit zur Umsetzung?
Hier mein Beispielcode:
Sub GetOpen_CHRs()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'Variablendeklaration
Dim varRetVal As Variant
Dim n, x As Integer
x = 1
n = 1
'Dateiauswahlfenster und Definition des Startordnerpfads
ChDir "Beispielpfad"
varRetVal = Application.GetOpenFilename(FileFilter:="Microsoft Excel-Dateien (*.txt), *.txt", _
_
Title:="Bitte wählen Sie die Dateien aus", MultiSelect:=True)
'Öffnen aller ausgewählten Dateien
If IsArray(varRetVal) Then
On Error Resume Next
For n = LBound(varRetVal) To UBound(varRetVal)
Workbooks.Open varRetVal(n)
With ActiveSheet.QueryTables.Add(Connection:=varRetVal(n), Destination:=Range("$A$1"))
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 1252
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
_
1, 1, 1, _
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileThousandsSeparator = "'" 'dient der Beseitigung der Tausendertrennzeichen die _
_
sonst automatisch gesetzt werden
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
'Übertragung der geöffneten Dateien in die Tabellenblätter
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("Beispieldatei.xlsm").Activate
Sheets("Beispieltabellenblatt_" & x).Select
x = x + 1
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, _
Transpose:=False
'Schließen der geöffneten Importdateien
For Each Wkb In Workbooks
If Wkb.Name ThisWorkbook.Name Then
Wkb.Close savechanges:=False
End If
Next Wkb
Next
On Error GoTo 0
End If
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Call Beispielsub
End Sub
Bin über jede Hilfe dankbar!
Beste Grüße
Cornelius