AW: msoFileDialogSaveAs
25.01.2017 14:10:23
onur
Das hier könnte Dir helfen.
DAS in ein MODUL:
Function FileSelection(ByVal Endung As String) As Variant
FileSelection = Application.GetOpenFilename(FileFilter:="Excel-Dateien (" + Endung + ")," + _
Endung, MultiSelect:=True)
End Function
Hier ein Beispiel zum Aufrufen:
Sub CSVimport()
'Makroname zum Impotieren von CSV-Dateien
Dim pfad As Variant
Dim DateinameKurz As Variant
Dim WS As Worksheet
pfad = FileSelection("*.csv")' Hier wird die Funktion aufgerufen _
i>
On Error GoTo weiter
If pfad = False Then Exit Sub
weiter:
u = UBound(pfad)
For i = 1 To UBound(pfad)
Dim TestArray() As String
TestArray = Split(pfad(i), "\")
Dateiname = TestArray(UBound(TestArray))
DateinameKurz = Left(Dateiname, Len(Dateiname) - 4)
ActiveWorkbook.Worksheets.Add
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & pfad(i), Destination:=Range(" _
A1"))
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 65001
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
ActiveSheet.Name = DateinameKurz
Next i
End Sub