Export to a HTML-file
1999-10-13 Import & Export 0 319
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