Designtime FP2003 macro: Howto add a HTML-Tag that wraps another tag?

[OLI]

Hello,



does anybody has an idea for a solution of this?



I'm doing some Frontpage work to publish a travel-diary. After writing the
text, I'm inserting the pic as Thumbnails.

Then on each thumb a link is inserted that displays a medium resolution pic
if clicked.



Now using VBA for EXCEL, ACCESS and WORD for quite a while, I wanted to
automate the daring task

of inserting all those hyperlinks.

The VBA routine basically should traverse all tags of the body, an process
on those IMG-tags that don't have

a Link-Tag <A .. > as parent-tag.



Hence what I want to do in VBA is quite basic HTML: Wrapping a Tag into
another Tag. After some search

in the VBA-Documentation, which is actually based on a
JSscript-Documentation I think that the method

APPLYTAG should do the job. But then things get sticky...



I first show my code and then there is a more detailed description of the
problem an the resulting questions.



So here is the code for this tag traversal

' ------------------- cut &
paste -------------------------------------------



' Enter the job of processing the body of one doc

Sub process_document_body(doc As DispFPHTMLDocument)
Dim body_tag As Object
'Dim body_tag As FPHTMLBody
Dim tag As Object
Set body_tag = doc.All.tags("body")
For Each tag In body_tag
parse_tag doc, tag, 1
Next tag
Debug.Print "Processing .."; doc.Title
End Sub





' now here the recursive traversal of all HTML-tags

Sub parse_tag(doc As DispFPHTMLDocument, html_tag As Object, level As Long)

const showTheProblem = true
' Process all HTML tag of a Doc.Body

' Recursive routine in preorder processing
Dim tag1 As Object 'generic variable
Dim tagstring As Variant
Dim NewTag As IHTMLElement
If html_tag.tagName = "img" And html_tag.parentElement.tagName <> "a" _
And InStr(1, html_tag.src, "picDB/small") > 0 Then
Debug.Print level; " Parent: <"; html_tag.parentElement.tagName; ">
Tag: "; " <"; html_tag.tagName; "> IMG_Src: "; html_tag.src
' Eg. "picDB/small/usa2003_098.jpg" transform to
"picDB/medium/usa2003_098.jpg", dann
' Eg. beforebegin <a href="picDB/medium/usa2003_098.jpg">
tagstring = shiftquoteB("<a href=#" & html_tag.src & "#></a>")
' Switch the SRC-Property to MEDIUM
Replace tagstring, "picDB/small", "picDB/medium"

debug.print "New tagstring "; tagstring

if showTheProblem then
Set NewTag = doc.createElement(tagstring)
html_tag.applyElement NewTag ' < ==== Here the problem
shows up

endif
End If
For Each tag1 In html_tag.Children
parse_tag doc, tag1, level + 1
Next tag1
End Sub

' ------------------- cut &
paste -------------------------------------------





To try the code, whitout running into the said problem you can set the CONST
showTheProblem = false.

The code then does simply some list-processing into debug.print output. You
will also need the helper Function

below.



ENVIRONMENT OF THE WEB

The small pics are in a subfolder "picDB/small"

The medium pics are in a subfolder "picDB/medium"

The applyElement methode is documented in Microsoftdocumentation of the
BODY-Object and other elements, that is

referenced by frontpage-VBA (Web Workshop | DHTML, HTML & CSS) .




PROBLEM

html_tag.applyElement NewTag

results to a runtime error 5, something like "Illegal procedure call oder
illegal argument" (translated from german ).

The MS-Documentation says some routines can not be called in VBA,

because of a typeconflict.





QUESTION

Is there a way to go around this?



Eg. can I override the Typeconflict somehow?

Eg. should I write the code in JScript, and mix it somehow with VBA? But
then how can I call it from VBA at designtime?

Some other ways to get the job done?



Actually I want to something quite basic. Either I don't understand
something yet or is it MS/redmont that lets here the VBA-Frontpage

programmer standing in the rain?







You also need this auxillary routines, to run the code

' ------------------- cut &
paste -------------------------------------------



Function shiftquoteF(str As String) As String
' substitute quote1 with quote2
Const quote1 = """"
Const quote2 = "#"
Dim k As Integer
Dim targetstring As String
targetstring = ""
For k = 1 To Len(str)
If Mid(str, k, 1) = quote1 Then
targetstring = targetstring & quote2
Else
targetstring = targetstring & Mid(str, k, 1)
End If
Next k
shiftquoteF = targetstring
End Function 'shiftquoteF



Function shiftquoteB(str As String) As String
' substituiert quote1 mit quote2
Const quote2 = """"
Const quote1 = "#"
Dim k As Integer
Dim targetstring As String
targetstring = ""
For k = 1 To Len(str)
If Mid(str, k, 1) = quote1 Then
targetstring = targetstring & quote2
Else
targetstring = targetstring & Mid(str, k, 1)
End If
Next k
shiftquoteB = targetstring
End Function 'shiftquoteB





Function ident(tablevel As Long) As String
Dim k As Integer
ident = ""
For k = 1 To tablevel
ident = ident & " "
Next k
End Function

' ------------------- cut &
paste -------------------------------------------