ich versuche ein Makro zu schreiben, welches mir alle CSV Dateien eines Ordners wieder gibt. Dabei möchte ich nur den Ordner wählen und nicht per Multiselect alle vorhandenen Dateien. das würde mir schon sehr helfen.
Idellerweise sollte der Pfad mit Thisworkbook.Path abgegriffen werden und durch die Unterverzeichnisse z.B. SPOS erweitert werden, so dass ich das Makro starten und alles automatisiert abläuft.
Das Makro was ich bereits habe funktioniert, aber eben die manueller Auswahl alles csv.
Gruß und Dank vorab
Mesel
Sub FLD()
Dim file
Dim dat
Dim bolOeffnen As Boolean
Set dat = Application.FileDialog(msoFileDialogFilePicker)
ChDrive ThisWorkbook.Path
ChDir ThisWorkbook.Path
With dat
.Title = "Daten auswählen...."
.InitialFileName = "" 'oder was auch immer
.AllowMultiSelect = True 'Man kann mit gedrückter Strg-Taste mehrere Dateien auswählen
.Filters.Clear
.Filters.Add "CSV", "*.CSV"
bolOeffnen = .Show
If bolOeffnen = True Then 'Es wurde etwas ausgewählt
For Each file In .SelectedItems 'Schleife über alle ausgewählten Dateien
Application.ScreenUpdating = False
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & file, Destination:=Range( _
"A61"))
.Name = "FLD"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlOverwriteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = False
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 850
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = True
.TextFileColumnDataTypes = Array(1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Application.ScreenUpdating = True
Next file
Else:
'MsgBox "Es wurde nichts ausgewählt und ""Abbrechen"" geklickt!"
End If
End With
End Sub
Office 2010
Win 7 / Linux Redhat 5