Sub DatZuXlsKovertieren_2()
Dim PathAndFileNames As Variant
Dim strPathAndFile$
Dim strPath$
Dim strFileName$
Dim xi&
Dim wbk As Workbook
ChDrive "C:\"
ChDir _
"C:\**\"
PathAndFileNames = Application.GetOpenFilename( _
FileFilter:="Dat Files (*.dat), *.dat", _
Title:="Strg Taste gedrückt halten und mehrere Files anklicken", _
MultiSelect:=True)
If VarType(PathAndFileNames) = vbBoolean Then
MsgBox "Abgebrochen!"
Else
For xi& = LBound(PathAndFileNames) To UBound(PathAndFileNames)
strPathAndFile = PathAndFileNames(xi&)
strFileName = Split(Dir(strPathAndFile, 63), ".", -1, 0)(0)
strPath$ = Mid(strPathAndFile, 1, Len(strPathAndFile) - Len(strFileName))
Workbooks.OpenText Filename:=strPathAndFile, _
Origin:=xlMSDOS _
, StartRow:=4, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=False, Comma:=False, _
Space:=True, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3 _
, 1), Array(4, 1), Array(5, 1), Array(6, 1)), DecimalSeparator:=".", _
ThousandsSeparator:=" ", TrailingMinusNumbers:=True
Set wbk = ActiveWorkbook
wbk.SaveAs Filename:=strPath & strFileName & ".xls", _
FileFormat:=xlNormal, _
Password:="", _
WriteResPassword:="", _
ReadOnlyRecommended:=False, _
CreateBackup:=False
wbk.Close
Next
End If
End Sub