Can't save Word doc

[axiomcrs]

I am having trouble saving the Word doc in the macro below and can't figure out why. The macro seems to run successfully, but when I close Word, it asks if I want to save the doc. Any suggestions?

Sub SearchDocByLine()
Dim RegExp As Object
Set RegExp = CreateObject("vbscript.regexp")
Dim re As RegExp
Set re = New RegExp
re.Pattern = "^[\t\+][0-9]+\."
re.IgnoreCase = True
re.Global = True
Application.ScreenUpdating = False
Dim i As Integer, Rng As Range
Dim intVal As Integer
Dim mymatches As MatchCollection
Dim mymatch As match
Dim names() As String
Dim namesindented() As String
Dim j As Integer
Dim pagenumber As Integer
Dim msgString As String
Dim temp As String
Dim strTemp As String
Dim x As Integer
Dim y As Integer
Dim lngMin As Long
Dim lngMax As Long
Dim temp1 As String
Dim temp2 As String
Dim namestotal As Integer
Dim printdebug As Integer
Dim wrdApp As Word.Application
Dim wrdDoc As Word.Document
Dim z As Integer
'Dim f As Integer
'Const WODDOC As String = "C:\Project2\output\master.doc"
'f = FreeFile
'Open WODDOC For Output As #f 'opens the file in I/O stream
'Close #f 'closes and saves new, blank file
'Shell "winword " & WODDOC, vbMaximizedFocus

Set wrdApp = CreateObject("Word.Application")
wrdApp.Visible = False
'Set wrdDoc = wrdApp.Documents.Open("C:\Project2\output\master.doc")
Set wrdDoc = wrdApp.Documents.Add
ChDir "C:\KenGraves\Project2\input"
myName = Dir("*.DOC")

j = 0
printdebug = 0
namestotal = 0

With wrdDoc
'Concatenate files
While myName <> ""
With Selection
.InsertFile FileName:=myName, ConfirmConversions:=False
.InsertParagraphAfter
.InsertBreak Type:=wdSectionBreakNextPage
.Collapse Direction:=wdCollapseEnd
End With
myName = Dir()
Wend
With Selection
.TypeText Text:="INDEX"
.InsertParagraphAfter
.InsertParagraphAfter
.InsertBreak Type:=wdSectionBreakNextPage
.Collapse Direction:=wdCollapseEnd
End With

With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "?"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchWildcards = True
.Execute
End With
Do While .Find.found
i = i + 1
Set Rng = .Duplicate
Set Rng = Rng.GoTo(What:=wdGoToBookmark, Name:="\line")
re.Pattern = "^[\t\+][0-9]+\."
'Test if line contains a descendant
If (re.test(Rng.Text)) Then
If printdebug = 1 Then
MsgBox "Rng.Text=" & Rng.Text
MsgBox "Page num=" & Rng.Information(wdActiveEndPageNumber)
End If
'Get first descendant
re.Pattern = "^([\t\+][0-9]+\.\t)([.a-zA-Z ]+),"
Set mymatches = re.Execute(Rng.Text)
If mymatches.Count = 1 Then
If mymatches(0).SubMatches(1) <> "infant" And mymatches(0).SubMatches(1) <> "daughter" Then
If printdebug = 1 Then
MsgBox "Desc=" & mymatches(0).SubMatches(1)
End If
j = j + 1
ReDim Preserve names(j)
names(j) = mymatches(0).SubMatches(1) & " " & Rng.Information(wdActiveEndPageNumber)
End If
End If
'Get married name that follows m.
re.Pattern = "(, m\. )([\'\.a-zA-Z ]+)"
Set mymatches = re.Execute(Rng.Text)
If mymatches.Count = 1 Then
If mymatches(0).SubMatches(1) <> "------" Then
If printdebug = 1 Then
MsgBox "m.=" & mymatches(0).SubMatches(1)
End If
j = j + 1
ReDim Preserve names(j)
names(j) = mymatches(0).SubMatches(1) & " " & Rng.Information(wdActiveEndPageNumber)
End If
End If
'Get married name that follows m(1)
re.Pattern = "(m\(1\) )([\'\.a-zA-Z ]+)"
Set mymatches = re.Execute(Rng.Text)
If mymatches.Count = 1 Then
If printdebug = 1 Then
MsgBox "m1=" & mymatches(0).SubMatches(1)
End If
j = j + 1
ReDim Preserve names(j)
names(j) = mymatches(0).SubMatches(1) & " " & Rng.Information(wdActiveEndPageNumber)
End If
'Get married name that follows m(2)
re.Pattern = "(m\(2\) )([\'\.a-zA-Z ]+)"
Set mymatches = re.Execute(Rng.Text)
If mymatches.Count = 1 Then
If printdebug = 1 Then
MsgBox "m2=" & mymatches(0).SubMatches(1)
End If
j = j + 1
ReDim Preserve names(j)
names(j) = mymatches(0).SubMatches(1) & " " & Rng.Information(wdActiveEndPageNumber)
End If
'Get married name that follows m(3)
re.Pattern = "(m\(3\) )([\'\.a-zA-Z ]+)"
Set mymatches = re.Execute(Rng.Text)
If mymatches.Count = 1 Then
If printdebug = 1 Then
MsgBox "m3=" & mymatches(0).SubMatches(1)
End If
j = j + 1
ReDim Preserve names(j)
names(j) = mymatches(0).SubMatches(1) & " " & Rng.Information(wdActiveEndPageNumber)
End If
End If
If Rng.Text = "INDEX" Then Exit Do
.start = Rng.End
.Collapse wdCollapseEnd
.Find.Execute
Loop
End With 'ActiveDocument.Range
Set Rng = Nothing
Application.ScreenUpdating = True


printdebug = 1
namestotal = j
If printdebug = 1 Then
MsgBox "namestotal=" & namestotal
End If

printdebug = 0
'Rearrange names to be last name first
For j = 1 To namestotal
temp = names(j)
re.Pattern = "([a-zA-Z \.\(\)\? ]+) ([a-zA-z]+)( [0-9]+)$"
Set mymatches = re.Execute(temp)
If mymatches.Count > 0 Then
If printdebug = 1 Then
MsgBox "M1=" & mymatches(0).SubMatches(0) & " M2=" & mymatches(0).SubMatches(1) & " M3=" & mymatches(0).SubMatches(2)
End If
names(j) = mymatches(0).SubMatches(1) & ", " & mymatches(0).SubMatches(0) & mymatches(0).SubMatches(2)
Else
If printdebug = 1 Then
MsgBox "No match"
End If
End If
Next j

printdebug = 0
If printdebug = 1 Then
For j = 1 To UBound(names)
MsgBox j & " = " & names(j)
Next j
End If

printdebug = 0
'Sort array
lngMin = 1
lngMax = namestotal
For x = lngMin To lngMax - 1
For y = x + 1 To lngMax
If names(x) > names(y) Then
strTemp = names(x)
names(x) = names(y)
names(y) = strTemp
End If
Next y
Next x

printdebug = 0
If printdebug = 1 Then
For j = 1 To namestotal
MsgBox j & " = " & names(j)
Next j
End If

printdebug = 1
'Indent array to give illusion of an index
ReDim Preserve namesindented(namestotal)
namesindented(1) = names(1)
'For j = 2 To namestotal
' re.Pattern = "^([a-zA-Z]+, )"
' Set mymatches = re.Execute(names(j - 1))
' If mymatches.Count > 0 Then
' If printdebug = 1 Then
' MsgBox "M1=" & mymatches(0).SubMatches(0) & " M2=" & mymatches(0).SubMatches(1) & " M3=" & mymatches(0).SubMatches(2)
' End If
' temp1 = mymatches(0).SubMatches(0)
' End If
' Set mymatches = re.Execute(names(j))
' If mymatches.Count > 0 Then
' If printdebug = 1 Then
' MsgBox "M1=" & mymatches(0).SubMatches(0) & " M2=" & mymatches(0).SubMatches(1) & " M3=" & mymatches(0).SubMatches(2)
' End If
' temp2 = mymatches(0).SubMatches(0)
' End If
' If printdebug = 1 Then
' MsgBox "temp1=" & temp1 & " temp2=" & temp2
' End If
' If temp1 = temp2 Then
' namesindented(j) = Right(names(j), Len(names(j)) - Len(temp1))
' namesindented(j) = Space(Len(temp1)) & namesindented(j)
' If printdebug = 1 Then
' MsgBox "names=" & names(j) & " namesindented=" & namesindented(j)
' End If
' End If
'Next j

'Write array to doc
For z = 1 To namestotal
ActiveDocument.Content.InsertAfter (names(z)) & vbCrLf
MsgBox "Written string=" & names(z)
Next z

If Dir("C:\Project2\output\master.doc") <> "" Then
Kill "C:\Project2\output\master.doc"
End If
.SaveAs ("C:\Project2\output\master.doc")
.Close ' close the document
End With 'wrddoc
wrdApp.quit ' close the Word application
Set wrdDoc = Nothing
Set wrdApp = Nothing

End Sub

[ayltonasc]

You are saying even if you accept to save it doesn't save at all, right?

Try to kill the normal template.
First make a backup of your code and the normal.dot file, doing this:

Search for the normal.dot file in your disk, make a copy of it an rename it to normalold.dot, then delete the normal.dot file.

Open word again, get your code saved, paste it back on.

See if this works, If it didn't, it should be a problem related to references assigned to your project. Try to investigate it and then give us a feedback.

Regards.

[axiomcrs]

I will need the macro to save the changes to the file without user interaction.
Which it does not do. And to answer your question, it does not accept when I try to save the changes when it asks me thru a dialog box, it reports that it cannot start wps602.exe or something similar. I tried to rename the normal.dotm file and then I reinstalled the macro and I got the same error. The references that are in place are VB for Apps, MS Word 14 Object library, OLE Automation, and MS VBScript 5.5. It could perhaps be a permission issue with it not saving. Are there return values for these functions that can provide more info as to its result?

[ayltonasc]

my bad, I thought you saying that your trying to save your code or the template and the word application was saying you can't.
I'm sorry, please forget what I said.

[axiomcrs]

Thanks for the suggestion. It turns out that the file with the filename that I am interested in (i.e. master.docx) does get saved, but when I open it, the file is blank. Just to clarify, the file I want to save master.docx gets saved, but when I close Word, it asks to save and I must provide another name.