Export to a HTML-file

 1999-10-13    Import & Export    0    93

With the macro below you can export values or formulas from a worksheet range to a HTML-file:

Sub ExportRangeAsHTML(SourceRange As Range, TargetFile As String, _
    TableSize As String, UseRangeColumnWidths As Boolean, _
    TableBorderSize As Integer, CellPadding As Integer, _
    CellSpacing As Integer, IncludeEmptyCells As Boolean)
' Exports the data in SourceRange to the textfile TargetFile in HTML format
' Example:     ExportRangeAsHTML Range("A3:E23"), "C:\FolderName\HtmlText.htm", "", True, 1, 5, 0, True
Dim A As Integer, r As Long, c As Integer, totr As Long, pror As Long
Dim fn As Integer, LineString As String, tLine As String, CellColumnWidth As Long
Dim BoldCell As Boolean, ItalicCell As Boolean, CellAlignment As Integer
    ' validate the input data if necessary
    If SourceRange Is Nothing Then Exit Sub
    If Len(TargetFile) = 0 Then Exit Sub
    If Application.WorksheetFunction.CountA(SourceRange) = 0 Then
        If Not IncludeEmptyCells Then Exit Sub
    End If
    On Error Resume Next
    Kill TargetFile
    On Error GoTo 0
    If Len(Dir(TargetFile)) > 0 Then
        MsgBox TargetFile & " already exists, rename, move or delete the file before you try again.", vbInformation, "Export range to textfile"
        Exit Sub
    End If
    
    ' perform export
    On Error GoTo NotAbleToExport
    fn = FreeFile
    Open TargetFile For Append As #fn ' open textfile for new input
    On Error GoTo 0
    ' determine the total number of rows to process
    totr = 0
    For A = 1 To SourceRange.Areas.Count
        totr = totr + SourceRange.Areas(A).Rows.Count
    Next A
    ' start the HTML file
    Print #fn, "<html>"
    Print #fn, "<head>"
    Print #fn, "<meta name=""DESCRIPTION"" content=""Description of content"">"
    Print #fn, "<meta name=""KEYWORDS"" content=""Keywords"">"
    Print #fn, "<title>Range to HTML from " & ActiveWorkbook.Name & "</title>"
    Print #fn, "</head>"
    Print #fn,
    Print #fn, "<body>"
    Print #fn, "<h1>Range to HTML from " & ActiveWorkbook.Name & "</h1>"
    Print #fn,
    If TableSize = "" Then
        Print #fn, "<table border=""" & TableBorderSize & """ cellpadding=""" & CellPadding & """ cellspacing=""" & CellSpacing & """>"
    Else
        Print #fn, "<table border=""" & TableBorderSize & """ cellpadding=""" & CellPadding & """ cellspacing=""" & CellSpacing & """ width=""" & TableSize & """>"
    End If
    ' start writing the HTML-file
    pror = 0
    For A = 1 To SourceRange.Areas.Count
        For r = 1 To SourceRange.Areas(A).Rows.Count
            If pror Mod 50 = 0 Then
                Application.StatusBar = "Writing the HTML-file " & Format(pror / totr, "0 %") & "..."
            End If
            Print #fn, "  <tr>"
            For c = 1 To SourceRange.Areas(A).Columns.Count
                LineString = "    "
                CellAlignment = 0
                tLine = ""
                On Error Resume Next
                With SourceRange.Areas(A).Cells(r, c)
                    tLine = Trim(.Text)
                    BoldCell = .Font.Bold
                    ItalicCell = .Font.Italic
                    CellAlignment = .HorizontalAlignment
                End With
                On Error GoTo 0
                If (tLine = "" Or tLine = " ") And IncludeEmptyCells Then tLine = " "
                If tLine <> "" Then
                    LineString = LineString & "<td"
                    If UseRangeColumnWidths Then
                        CellColumnWidth = CLng(Cells(1, c + 1).Left - Cells(1, c).Left)
                        LineString = LineString & " width=""" & CellColumnWidth & """"
                    End If
                    If CellAlignment = xlHAlignGeneral Then
                        Select Case Asc(tLine)
                            Case 45, 48 To 57
                                CellAlignment = xlHAlignRight
                        End Select
                    End If
                    If CellAlignment = xlHAlignCenter Then LineString = LineString & " align=""center"""
                    If CellAlignment = xlHAlignRight Then LineString = LineString & " align=""right"""
                    LineString = LineString & ">"
                    If BoldCell Then LineString = LineString & "<b>"
                    If ItalicCell Then LineString = LineString & "<i>"
                    LineString = LineString & tLine
                    If ItalicCell Then LineString = LineString & "</i>"
                    If BoldCell Then LineString = LineString & "</b>"
                    LineString = LineString & "</td>"
                    Print #fn, LineString
                End If
            Next c
            Print #fn, "  </tr>"
            pror = pror + 1
        Next r
    Next A
    ' end the HTML file
    Print #fn, "</table>"
    Print #fn,
    Print #fn, "</body>"
    Print #fn, "</html>"
    Close #fn ' close the targetfile
NotAbleToExport:
    Set SourceRange = Nothing
    Application.StatusBar = False
End Sub


Leave a comment:

Your comment will only be published after it has been moderated and found spam free.
Your e-mail address will only be used to display your Gravatar.