I really hope someone can help me finish this demonstration!
Can anyone pls create some HTML web page code, which will run the
following VBA procedure named ConvertWordToXMLandHTML, when a
command button or a filefield ActiveX Browse object is clicked.
I am not good at writing HTML code and am not experienced with VB
Script either.
I think that my VBA procedure will have to be converted to VB Script?
I wrote this VBA procedure in Excel's VB Editor and it runs OK.
It parses a Word document by checking each of its paragraphs and
puts that data into a text file, which ends up being an XML data
file named Parent.xml. A second text file is created called
Parent.html, which is displays the data in Parent.xml using a XSL
Transformation stylesheet named Stylesheet.xsl
I will have to send you two files, ie the Word document file named
Parenting and Gobble.doc, as well as the XSL Transformation
stylesheet file, Stylesheet.xsl
Here is the ConvertWordToXMLandHTML sub procedure code.
Sub ConvertWordToXMLandHTML()
Dim objWordApp
Dim objWordDoc 'is Word document to convert
Dim objTextDoc 'will become ?.xml data file
Dim objHTMLdoc 'will be the HTML file to display output in IE 6
Dim rngTarget
Dim strPath
Dim strFileNameOnly
strPath = ThisWorkbook.Path & "\"
ChDir strPath
'CREATE THE XML file.
Set objWordApp = CreateObject("Word.Application")
objWordApp.Visible = True
'Open Doc to convert.
Set objWordDoc = GetObject(strPath & "Parenting and
Gobble.doc", "Word.Document")
strFileNameOnly = objWordDoc.Name
strFileNameOnly = Left(strFileNameOnly, InStr(1,
strFileNameOnly, " ", 1) - 1)
Debug.Print strFileNameOnly
'Create the XML file and add the processing instruction.
Set objTextDoc = objWordApp.Documents.Add
Set rngTarget = objTextDoc.Content
With rngTarget 'This is very illogically set up
'in the Word document!
.Style = "Normal"
.Style.Font.Size = 10
.Text = "<?xml version='1.0'?>"
.InsertParagraphAfter
.Collapse wdCollapseEnd 'Move cursor to end of range.
.Text = "<Parenting-and-gobble>" 'Root element start name tag
.InsertParagraphAfter
.InsertParagraphAfter
.Collapse wdCollapseEnd
.Text = "<Topic>Parenting-and-Gobble</Topic>"
.InsertParagraphAfter
.Collapse wdCollapseEnd
'Loop thru the Word doc's paragraphs to find text + add to XML file.
For Each para In objWordDoc.Content.Paragraphs
Select Case para.Style
Case "Title", "Subtitle", "Heading 1", "Body Text"
.Text = vbTab & "<Parenting>" & para.Range.Text
& "</Parenting>"
.InsertParagraphAfter
.Collapse wdCollapseEnd
Case "List Bullet 2"
.Text = vbTab & vbTab & "<Stage>" &
para.Range.Text & "</Stage>"
.InsertParagraphAfter
.Collapse wdCollapseEnd
Case "Family1"
.Text = vbTab & "<Family>"
.InsertParagraphAfter
.Collapse wdCollapseEnd
Case "Family2"
.Text = vbTab & "</Family>"
.InsertParagraphAfter
.Collapse wdCollapseEnd
Case Else
.Text = vbTab & "<Gobble>" & para.Range.Text
& "</Gobble>"
.InsertParagraphAfter
.Collapse wdCollapseEnd
End Select
Next para
'Clean up manual page breaks in XML file.
With objTextDoc.Content.Find
.ClearFormatting
.Text = "&"
With .Replacement
.ClearFormatting
.Text = "&"
End With
.Execute Format:=False, Replace:=wdReplaceAll
End With
'Add final root element tag.
.SetRange Start:=objTextDoc.Content.Start,
End:=objTextDoc.Content.End
.InsertParagraphAfter
.Collapse wdCollapseEnd
.Text = "</Parenting-and-gobble>"
End With
'Save the XML file as a text file, with a .xml extension.
' saving as a text file should remove any manual page breaks
line breaks.
objTextDoc.SaveAs Filename:=strPath & strFileNameOnly & ".xml",
FileFormat:=wdFormatText
objTextDoc.Close
Set objTextDoc = Nothing
'Close and clean up Word document that was converted.
objWordDoc.Close
Set objWordDoc = Nothing
'CREATE THE HTML file
' Chr$(13) = a carriage return
' Chr$(34) = a double-quote
Set objHTMLdoc = objWordApp.Documents.Add
Set rngTarget = objHTMLdoc.Content
'The following code adds the text which properly displays the HTML
page.
' Note: that strFileNameOnly correctly names this matching HTML
file, so that
' both the XML file and the HTML file have the same filename,
' but different file extensions.
rngTarget.Text = _
"<HTML>" & Chr$(13) & _
"<BODY>" & Chr$(13) & _
"<DIV ID=" & Chr$(34) & "show" & Chr$(34) & "></DIV>" & Chr$(13) & _
"<XML ID=" & Chr$(34) & "style" & Chr$(34) & " SRC=" & Chr$(34)
& "Stylesheet.xsl" & Chr$(34) & "></XML>" & Chr$(13) & _
"<!-- HTML page using MS XML Data Islands -->" & Chr$(13) & _
"<SCRIPT>" & Chr$(13) & _
"function showData(){" & Chr$(13) & _
"if (xml.readyState == " & Chr$(34) & "complete" & Chr$(34) & ")
{" & Chr$(13) & _
"show.innerHTML = xml.transformNode(style.documentElement);" &
Chr$(13) & _
"}" & Chr$(13) & _
"}" & Chr$(13) & _
Chr$(13) & _
"document.writeln('" & Chr$(34) & "<XML ID=" & Chr$(34) & "xml" &
Chr$(34) & " SRC=" & strFileNameOnly & ".xml onreadystatechange=" &
Chr$(34) & "showData()" & Chr$(34) & "></XML>');" & Chr$(13) & _
"</SCRIPT>" & Chr$(13) & _
Chr$(13) & _
"</BODY>" & Chr$(13) & _
"</HTML>"
objHTMLdoc.SaveAs Filename:=strPath & strFileNameOnly & ".html",
FileFormat:=wdFormatText
objHTMLdoc.Close
'Clean up objects
'Set objHTMLdoc = Nothing
'Set rngTarget = Nothing
'objWordApp.Quit
'Set objWordApp = Nothing
End Sub