Single Button Save to MHT file

[Craig Roberts]

How do I connect this to my normal template?

What I want is a tool bar button that calls this

Sub SaveAsTextFileMHT()
Dim strDocName As String
Dim intPos As Integer

'Find position of extension in filename
strDocName = ActiveDocument.Name
intPos = InStrRev(strDocName, ".")

If intPos = 0 Then

'If the document has not yet been saved
'Ask the user to provide a filename
strDocName = InputBox("Please enter the name " & _
"of your document.")
Else

'Strip off extension and add ".mht" extension
strDocName = Left(strDocName, intPos - 1)
strDocName = strDocName & ".mht"
End If

'Save file with new extension
ActiveDocument.SaveAs FileName:=strDocName, _
FileFormat:=wdFormatWebArchive
End Sub