Problem with VBA Code

[Jennifer Corner]

Hello! I am a VBA novice. I have a problem that I have been working on for a few days and I am now seeking professional help. :) I inherited a project from a co-worker who is no longer on the project. It includes a macro code that is supposed to take a mail merged document, split it into seperate documents and then save as html each of the documents using the first line of the document as a title. However, it is not working on my machine. All it does is take the file, prompts me for a name, and then it closes the document. Everything is saved as one file under the name and location I enter.

I am using Word 2007 on PC. The person I inherited this from was using Word on Mac. I am not sure if that is part of the problem. The code is below. Thanks for the help.

Sub SplitMergeLetter()
' splitter Macro modified to save individual letters with
' information from data source. The filename data must be added to
' the top of the merge letter - see web article.
'
Dim sName As String
Dim docName As String
Dim Letters As String
Dim Counter As Long
Dim oDoc As Document
Dim oNewDoc As Document
Set oDoc = ActiveDocument
oDoc.Save
Selection.EndKey Unit:=wdStory
Letters = Selection.Information(wdActiveEndSectionNumber)
Selection.HomeKey Unit:=wdStory
Counter = 1
While Counter < Letters
Application.ScreenUpdating = False
With Selection
.HomeKey Unit:=wdStory
.EndKey Unit:=wdLine, Extend:=wdExtend
.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
End With
sName = Selection
docName = "" & sName & ".htm"
oDoc.Sections.First.Range.Cut
Set oNewDoc = Documents.Add
'Documents are based on the Normal template
'To use an alternative template follow the link.
With Selection
.Paste
.HomeKey Unit:=wdStory
.MoveDown Unit:=wdLine, Count:=1, Extend:=wdExtend
.Delete
End With
oNewDoc.SaveAs fileName:=docName, _
FileFormat:=wdFormatHTML, LockComments:=False, Password:="", AddToRecentFiles:=True, _
WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _
False, HTMLDisplayOnlyOutput:=False, MaintainCompat:=False
ActiveWindow.Close
Counter = Counter + 1
Application.ScreenUpdating = True
Wend
oDoc.Close wdDoNotSaveChanges
End Sub

[Jennifer Corner]

I fixed the problem. Thanks for looking!

For those that are curious, the new code is as follows:

Sub BreakOnSection()
' Used to set criteria for moving through the document by section.
Application.Browser.Target = wdBrowseSection

'A mail merge document ends with a section break next page.
'Subtracting one from the section count stop error message.
For i = 1 To ((ActiveDocument.Sections.Count) - 1)

'Note: If a document does not end with a section break,
'substitute the following line of code for the one above:
'For I = 1 To ActiveDocument.Sections.Count

'Select and copy the section text to the clipboard.
ActiveDocument.Bookmarks("\Section").Range.Copy

'Create a new document to paste text from clipboard.
Documents.Add
Selection.Paste
'Select first line of document to use as file name

With Selection
.HomeKey Unit:=wdStory
.EndKey Unit:=wdLine, Extend:=wdExtend
.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
End With
sName = Selection

' Removes the break that is copied at the end of the section, if any.
Selection.MoveUp Unit:=wdLine, Count:=1, Extend:=wdExtend
Selection.Delete Unit:=wdCharacter, Count:=1
ChangeFileOpenDirectory "C:\???"
DocNum = DocNum + 1
ActiveDocument.SaveAs FileName:="" & sName & ".htm", FileFormat:=wdFormatHTML, LockComments:=False, Password:="", AddToRecentFiles:=True, _

WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _
False

ActiveDocument.Close
' Move the selection to the next section in the document.
Application.Browser.Next
Next i
ActiveDocument.Close savechanges:=wdDoNotSaveChanges
End Sub