Sub
TryIt()
Dim
wB
As
Workbook, wS
As
Worksheet
Dim
strPath
As
String
, strFile
As
String
With
Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect =
False
.InitialFileName = "G:\PG-D22\_Mitarbeiter\Kettner\"
.Title =
"Ordner auswählen"
If
.Show
Then
strPath = .SelectedItems(1)
Else
Call
MsgBox(
"Sie haben kein Verzeichnis ausgewählt,"
& _
Chr(10) &
"das Programm wird beendet!"
, _
vbCritical,
"Abbruch"
)
Exit
Sub
End
If
End
With
strPath = IIf(Right(strPath, 1) =
"\", strPath, strPath & "
\")
strFile = Dir(strPath &
"*.xls?"
)
Do
While
strFile <>
""
Set
wB = Workbooks.Open(strPath & strFile)
For
Each
wS
In
wB.Sheets
On
Error
Resume
Next
wS.SaveAs strPath & wS.Name, xlCSV, _
CreateBackup:=
False
, local:=
True
On
Error
GoTo
0
Next
wS
wB.Close
False
strFile = Dir
Loop
End
Sub