Option Explicit
Sub BlattZuHtm()
Dim wks As Worksheet
Dim strBlatt As String
Dim strMappe As String
Dim strFileName As String
Dim strPath As String
Dim fDialog As FileDialog
Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
With fDialog
.InitialFileName = "C:\"
.Title = "Wählen Sie den Ordner."
.ButtonName = "Ausählen"
.InitialView = msoFileDialogViewList
.Show
If .SelectedItems.Count <> 1 Then
GoTo Ende
End If
strPath = .SelectedItems(1)
End With
For Each wks In ActiveWorkbook.Worksheets
strBlatt = wks.Name
strFileName = strPath & strBlatt & ".htm"
With ActiveWorkbook.PublishObjects.Add( _
SourceType:=xlSourceSheet, _
Filename:=strFileName, _
Sheet:=strBlatt, _
Source:="", _
HtmlType:=xlHtmlStatic, _
DivID:="", _
Title:=strBlatt)
.Publish (True)
.AutoRepublish = False
End With
Next
Exit Sub
Ende:
MsgBox "Keine Auswahl getroffen"
Set fDialog = Nothing
End Sub