convhtml.bas

使用WebBrowser控件作为容器打开Word文档 === === === === === === === 这个源代码演示了使用WebBrowser控件作为容器打开Word文档的操作。需要在工

Attribute VB_Name = "ConvHTML"

Option Explicit
' ConvHTML.bas Mar, 2006 contact [e-mail]
' Function to save a Word Document as HTML programmatically
' Includes workaround for problem discussed in KB Q162132 (see below)
' ====================================================================

Public Function SaveDocAsHTML( _
                Doc As Word.Document, _
                NewFileName As String) As String
'
' Returns full path\name of saved file
'
    On Error GoTo SaveDocAsHTML_Error
    
    Dim Result As String ' default function result = ""
    Dim wrdApp As Word.Application
    Dim lngSaveFormat As Long
    
    Set wrdApp = Doc.Application
    lngSaveFormat = GetHTMLSaveFormat(WordApp:=wrdApp)
    If lngSaveFormat Then   ' File Converter for HTML is available for Save
        Doc.SaveAs FileFormat:=lngSaveFormat, FileName:=NewFileName
        With wrdApp.ActiveDocument
            Result = .Path & "\" & .Name
        End With
    End If
    
SaveDocAsHTML_Exit:
    SaveDocAsHTML = Result
    Exit Function
    
SaveDocAsHTML_Error:
    MsgBox Err.Number & " - " & Err.Description, vbExclamation, "SaveDocAsHTML"
    Resume SaveDocAsHTML_Exit
    
End Function

Private Function GetHTMLSaveFormat(WordApp As Word.Application) As Long
'
' KB Article Q162132 - WD97: Run-time error '5880' Saving as HTML from VBA
'
' Problem occurs when accessing the "HTML" document format
' from the FileConverters collection using a string value
' instead of a numerical value for the index.
'
    On Error GoTo GetHTMLSaveFormat_Exit
    
    Dim Result As Long  ' default function result = 0
    Dim wrdFileConverter As Word.FileConverter
    
    For Each wrdFileConverter In WordApp.FileConverters
        If wrdFileConverter.ClassName = "HTML" Then
            With wrdFileConverter
                If .CanSave Then
                    Result = .SaveFormat
                End If
            End With
            Exit For
        End If
    Next wrdFileConverter
    
GetHTMLSaveFormat_Exit:
    GetHTMLSaveFormat = Result
    
End Function