VBA wordapp.document.open and selection.WholeStory - vba

Question

Thank you in advance to looking and helping.
I'm trying to open a word document, then run some code on the document's contents, and save it. Here's what I have:
wordApp.Documents.Open (strFile)
wordApp.Visible = True
wordApp.Selection.WholeStory
strAll = wordApp.Selection.XML
This seems to get a handle to the contents of the document being opened. I can change search it, etc, and it appears to be changing the contents, however when I attempt to save it:
using this:
wordApp.ActiveDocument.Save NoPrompt:=True
or using this:
wordApp.ActiveDocument.SaveAs FileName:=folderName + "\test.xml", FileFormat:=wdFormatXML
the actual saved file isn't changed. If the actual document isn't being changed, and yet the changes are being made, where would the changes being made?
I can actually open the document, not as part of processing a folder, but opening it manually and run an action that has the same code in it and it makes the changes and prompts me to save when I close it. The ValidateFolder is the sub. It opens all .xml documents in a folder and validates contents, then I need to save any changes. The code for the whole things is:
Private Sub ValidateFolder_Click()
Dim wordApp
Dim folderName As Variant
Dim fileDir As String
Dim strAll As String
Dim strFile As String
Dim arrString() As String, occurInStr() As String, fldVal As String
Dim logResults As String
Dim dispVal As String
Dim i As Integer, v As Integer
Dim lnCount As Integer
Dim charPos As Long
folderName = BrowseForFolder("C:\")
lnCount = 0
If folderName <> "" Then
MsgBox ("check " + folderName)
fileDir = Dir$(folderName + "\*", 16)
Do While fileDir <> ""
If fileDir <> "." And fileDir <> ".." Then
Rem If entry is an xml file, then check the file.
If InStr(1, fileDir, ".xml", 5) > 0 Then
Set wordApp = CreateObject("word.Application")
strFile = folderName + "\" + fileDir
wordApp.Documents.Open strFile
wordApp.Visible = True
wordApp.Selection.WholeStory
strAll = wordApp.Selection.XML
arrString = Strings.Split(strAll, "»")
MsgBox ("Opened: " + strFile)
MsgBox (CStr(strAll))
For i = 0 To UBound(arrString)
'MsgBox (CStr(UBound(arrString)))
fldVal = strRight(arrString(i), "«")
'MsgBox (fldVal)
If fldVal <> "" Then
fldVal = fldVal & "»"
occurInStr = Split(fldVal, "»")
'MsgBox ("Match-" & CStr(i + 1) & ": " & fldVal & " occurances: " & CStr(UBound(occurInStr, 1)) & " error occur: " & CStr(InStrRegEx(fldVal, "«[A-Z_! ,d+0-9]*<.*»")))
If InStrRegEx(fldVal, "«[A-Z_! ,d+0-9]*<.*»") > 0 Then
Dim repVal As String
repVal = leftOfStrRightBack(fldVal, ">")
repVal = strRight(repVal, "<")
Dim newFldVal As String
newFldVal = Replace(fldVal, repVal, "")
Dim myRange As Range
Set myRange = ActiveDocument.Content
myRange.Find.Execute FindText:=newFldVal, Forward:=True
If myRange.Find.found = True Then
myRange.Find.Execute FindText:=newFldVal, ReplaceWith:="FLDSTART" & newFldVal, Format:=True, Replace:=wdReplaceAll
End If
Set myRange = ActiveDocument.Content
myRange.Find.Execute FindText:="FLDSTART", Forward:=True
If myRange.Find.found = True Then
myRange.Find.Execute FindText:="FLDSTART", ReplaceWith:="", Format:=True, Replace:=wdReplaceAll
End If
logResults = "errors"
If logResults = "" Then
logResults = "The Following Fields had errors:" & Chr(10) & " " & newFldVal
MsgBox (logResults = "The Following Fields had errors:" & Chr(10) & " " & newFldVal)
Else
logResults = logResults & Chr(10) & " " & newFldVal
End If
End If
End If
Next
If logResults = "" Then
MsgBox ("No errors")
Else
MsgBox ("errors")
End If
If logResults = "" Then
logResults = "Success!" & Chr(10) & Chr(10) & "There were no detected errors in fields."
Else
logResults = logResults & Chr(10) & Chr(10) & "They have been fixed." & Chr(10) & "Please save this document."
End If
MsgBox (logResults)
Rem Saving and closing the document.
wordApp.ActiveDocument.Save NoPrompt:=True
MsgBox ("Save and Quit now")
'wordApp.ActiveDocument.SaveAs FileName:=folderName + "\test.xml", FileFormat:=wdFormatXML
'wordApp.ActiveDocument.SaveAs (folderName + "\" + fileDir
'MsgBox ("Saved")
Exit Sub 'Stop here so you process only one document for testing.
wordApp.Quit SaveChanges:=wdSaveChanges, OriginalFormat:=wdWordDocument
End If
End If
fileDir = Dir$()
Loop
End If
End Sub
Function BrowseForFolder(Optional OpenAt As Variant) As Variant
Dim ShellApp As Object
'Create a file browser window at the default folder
Set ShellApp = CreateObject("Shell.Application"). _
BrowseForFolder(0, "Please choose a folder", 0, OpenAt)
'Set the folder to that selected. (On error in case cancelled)
On Error Resume Next
BrowseForFolder = ShellApp.self.Path
On Error GoTo 0
'Destroy the Shell Application
Set ShellApp = Nothing
'Check for invalid or non-entries and send to the Invalid error
'handler if found
'Valid selections can begin L: (where L is a letter) or
'\\ (as in \\servername\sharename. All others are invalid
Select Case Mid(BrowseForFolder, 2, 1)
Case Is = ":"
If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid
Case Is = "\"
If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid
Case Else
GoTo Invalid
End Select
Exit Function
Invalid:
'If it was determined that the selection was invalid, set to False
BrowseForFolder = False
End Function
Public Function GetFolder() As String
Dim fldr As FileDialog
Dim sItem As String
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
MsgBox (fldr)
With fldr
.Title = "Select a Folder"
.AllowMultiSelect = False
.InitialFileName = OpenAt 'Application.DefaultFilePath
If .Show <> -1 Then GoTo NextCode
sItem = .SelectedItems(1)
End With
NextCode:
GetFolder = sItem
Set fldr = Nothing
End Function
Public Function leftOfStrRightBack(ByVal searchIn As String, ByVal searchFor As String) As String
Dim charPos As Long
Dim retStr As String
retStr = ""
If InStr(1, searchIn, searchFor, 5) > 0 Then
charPos = Len(searchIn)
While charPos > 0
If CStr(Mid(searchIn, charPos, 1)) = searchFor Then
'MsgBox ("Searched: " & searchIn & " found: " & searchFor & " at pos: " & charPos)
retStr = CStr(Mid(searchIn, 1, charPos))
'MsgBox ("Return: " & retStr)
GoTo BreakOut
End If
charPos = charPos - 1
Wend
BreakOut:
End If
leftOfStrRightBack = CStr(retStr)
End Function
Public Function strRight(ByVal searchIn As String, ByVal searchFor As String) As String
Dim charPos As Long
Dim retStr As String
retStr = ""
charPos = InStr(1, searchIn, searchFor, 5)
If charPos > 0 Then
retStr = CStr(Mid(searchIn, charPos, Len(searchIn)))
End If
'CStr(CStr(Mid(arrString(i), charPos, Len(arrString(i))) & "»"))
strRight = CStr(retStr)
End Function
Public Function InStrRegEx(ByVal searchIn As String, ByVal searchFor As String) As Long
Dim regEx As Object, found As Object
If Len(searchIn) > 0 And Len(searchFor) > 0 Then
Set regEx = CreateObject("VBScript.RegExp")
regEx.Pattern = searchFor
regEx.Global = True
regEx.IgnoreCase = True
Set found = regEx.Execute(searchIn)
If found.Count <> 0 Then InStrRegEx = found(0).FirstIndex + 1
End If
End Function
Public Function getText(ByVal searchIn As String, ByVal searchFor As String) As String
Dim regEx As Object, found As Object
If Len(searchIn) > 0 And Len(searchFor) > 0 Then
Set regEx = CreateObject("VBScript.RegExp")
regEx.Pattern = searchFor
regEx.Global = True
regEx.IgnoreCase = True
Set found = regEx.Execute(searchIn)
If found.Count <> 0 Then getText = CStr(found(0))
End If
End Function