Save As .htm

S

Steve C

After merging 125 employee records into a one-page mail merge document, I
have the expected document (Results.doc) with 125 individual pages as a
result. I wish to save each page of this document as an individual .htm
file, using the first line of each page (the employee's name) as the file
name. I wish to save them to G:\Sample. The end result I'm looking for is
125 individual .htm files.

Is there a way to do this programmatically? Thanks in advance for any help
or ideas you can give me!
 
B

Brian

If you make each name a header,using the same format, try the following,
changing the base folder to where you want the output:

Sub xSplitter()

Dim DocumentData As String

Selection.WholeStory
Selection.Copy

BaseFolder = "D:\Output\"
BaseName = "Let"
Application.DefaultSaveFormat = "html"

Documents.Add
Selection.Paste


DocName = BaseFolder & BaseName
ActiveDocument.SaveAs FileName:=DocName
ActiveWindow.Close

Close

Open BaseFolder & BaseName & ".htm" For Input As #1

DocumentData = Input(LOF(1), #1)

Close

pos = InStr(DocumentData, "</head>")

DocumentHeader = Mid(DocumentData, 1, pos + Len("</head>"))

pos = InStr(DocumentData, "<body")

Counter = 1

While pos <> 0

StartOfHeader = InStr(pos, DocumentData, "<h1>")
endOfheader = InStr(pos, DocumentData, "</h1>")
StartOfNextHeader = InStr(StartOfHeader + 1, DocumentData, "<h1>")

HeaderTitle = Filter((Mid(DocumentData, StartOfHeader, endOfheader -
StartOfHeader)))

Open BaseFolder & BaseName & Right$("000" & LTrim$(Str$(Counter)), 3) &
"-" & HeaderTitle & ".htm" For Output As #1

Counter = Counter + 1

Print #1, DocumentHeader
Print #1, "<body>"
If StartOfNextHeader > 0 Then
Print #1, Mid(DocumentData, StartOfHeader, StartOfNextHeader -
StartOfHeader)
Else
Print #1, Mid(DocumentData, StartOfHeader)
End If

Print #1, "</body>"
Print #1, "</html>"

Close

pos = StartOfNextHeader

Wend

Close

End Sub


Hope it helps,
 
S

Steve C

Brian,

Thanks. I really appreciate the time and effort to help me. I've made each
name a header as you suggested, using <h1>EmployeeName</h1>, but I'm getting
a compile error "Argument not optional" on the following line:

HeaderTitle = Filter((Mid(DocumentData, StartOfHeader, endOfheader -
StartOfHeader)))

Thoughts?
 
B

Brian

That was code amended by another poster. So will have to check. The code I
initially sent is below, If you split the document into sections and run the
code, it should create individual html files calling each, LET1, LET2, etc. I
will try to amend the code to pick up the header for the file name.

Sub Splitter()
Selection.EndKey Unit:=wdStory
numlets = Selection.Information(wdActiveEndSectionNumber)
If numlets > 1 Then numlets = numlets - 1
Selection.HomeKey Unit:=wdStory
BaseName = "c:\Let"
Application.DefaultSaveFormat = "html"
For Counter = 1 To numlets
DocName = BaseName & Right$("000" & LTrim$(Str$(Counter)), 3)
ActiveDocument.Sections.First.Range.Cut
Documents.Add
Selection.Paste
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.Delete Unit:=wdCharacter, Count:=1
ActiveDocument.SaveAs FileName:=DocName
ActiveWindow.Close
Next Counter
End Sub

hope this is a step forward.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Page numbering with Merged Document and IF statements 1
Auto Populate One Pages from spreadsheet 0
MS Word List Bug 0
Auto Merge text from multiple sources 0
Difficulty with compatibility mode and Track Changes 2
We try to save msg in got the error in outlook 2021/office 365 0
Problem with SET & REF function 0
Macro to save word pages separately as PDF and name them according to text in third line 0

Top