Access Code partially stopped working (not populating data to word document) - vba

I have an Access database with linked tables. I have created a code to do the following:
1- Create a folder in a specific location with a specific name (name populated from data in access).
2- Open a word document saved in a specific path
3- I then use formfields in the document to populate the word document with data from the table
4- Lastly, I save the word document to the previously created folder with a new name using data from the table
I have been using this code successfully for well over a year with no issues.
Suddenly, for no apparent reason and without any change to the code it stopped populating the word document with data. note, its still doing steps 1,2, & 4 but not step 3.
I cannot figure out what the issue is and any help would be much appreciated.
Below is a sample of the code used:
Sub Onboarding_Documents_Saudi_Click()
'STEP ONE: create the appropriate Folder
Dim fs, cf, strFolder
On Error Resume Next
strFolder = "C:\Users\1161\OneDrive - Anfas Medical Care\Master - Anfas Medical Care\New Employees\" & Me.Name_In_English & " " & Me.Emp_Id
Set fs = CreateObject("Scripting.FileSystemObject")
If fs.FolderExists(strFolder) = True Then
MsgBox "'" & strFolder & "' already exists!"
Else
Set cf = fs.CreateFolder(strFolder)
If fs.FolderExists(strFolder) = True Then
MsgBox "'" & strFolder & "' successfully created!"
Else
MsgBox "'" & strFolder & "' was not successfully created!"
End If
End If
'STEP TWO:Make Contract .
Dim appWord As Word.Application
Dim doc As Word.Document
Dim Base As String
Base = Format(Me.base_salary, "Standard")
Dim Housing As String
Housing = Format(Me.housing_allowence, "Standard")
Dim Trans As String
Trans = Format(Me.transportation_allowence, "Standard")
On Error Resume Next
Err.Clear
Set appWord = GetObject(, "Word.Application")
If Err.Number <> 0 Then
Set appWord = New Word.Application
End If
Set doc = appWord.Documents.Open("C:\Users\1161\OneDrive - Anfas Medical Care\Master - Anfas Medical Care\Forms\Onboarding Documents\Access\Saudi\ContractSaudiAccess.docx", , True)
With doc
.FormFields("frnameinarabic").Result = Me.Name_In_Arabic
.FormFields("frnameinenglish").Result = Me.Name_In_English
.FormFields("frid").Result = Me.Document_ID_number
.FormFields("frmobile").Result = Me.mobile_number
.FormFields("frjtenglish").Result = Me.Job_title_English
.FormFields("frjtarabic").Result = Me.Job_Title_Arabic
.FormFields("frbasesalary").Result = Base
.FormFields("frhousing").Result = Housing
.FormFields("frtrans").Result = Trans
.FormFields("fremail").Result = Me.Personal_Email
.FormFields("empid").Result = Me.Emp_Id
.FormFields("joindate").Result = Me.Join_Date
.FormFields("joindatehijri").Result = Me.[Join Date Hijri]
.FormFields("contractperiod").Result = Me.[Contract Length]
.FormFields("contractperiodar").Result = Me.[Contract Length Ar]
.FormFields("frdepartment").Result = Me.Department
.FormFields("frdepartmentarabic").Result = Me.Department_Ar
.FormFields("joindate1").Result = Format(Me.Join_Date, "dddd dd/mmm/yyyy", vbUseSystemDayOfWeek)
.Activate
.Visible = True
.Activate
End With
doc.Fields.Update
doc.SaveAs2 "C:\Users\1161\OneDrive - Anfas Medical Care\Master - Anfas Medical Care\New Employees\" & Me.Name_In_English & " " & Me.Emp_Id & "\" & FileName & "Contract " & Me.Name_In_English & " " & Me.Emp_Id & ".docx"
Set doc = Nothing
Set appWord = Nothing```

Could this be a change due to Office Updates? I have something similar which works with Word v1910 (Build 12130.20272) but not in v2301 (Build 16026.20146). That may explain the second machine suddenly not working also?
It appears opening the "template" document which you are then adding information into opens read only as requested but now no longer allows changes to be made, which is where I think your code is skipping too? Our running code displays the Word document after filling in the form fields and there is no option to change the file mode to the top right of the screen to allow editing.
Screen shot of viewing / editing options from Word toolbar
I don't have an answer as to how to fix it as yet, I'm afraid, apart from making the template document open for write access and changing rights on the network to make the documents read only. We've not tested that as yet though. Hopefully it helps by giving you something else to check as the code has run successfully for a time and suddenly stopped.
I'm currently trying to find an option for opening a file as read only but allowing changes to the open document but am struggling to find anything like this in the Microsoft documentation. If I do find a solution I'll come back and post it.
It may work for you changing the following line from True to False at the end if the file is somewhere not shared.
Set doc = appWord.Documents.Open("C:\Users\1161\OneDrive - Anfas Medical Care\Master - Anfas Medical Care\Forms\Onboarding Documents\Access\Saudi\ContractSaudiAccess.docx", , True)

Related

Insert an image file in a MAC Word Userform

I am not a programmer so not sure what to do here. I would like an option of adding an image file in a Microsoft Word document userform for MAC. I had used a code earlier which works perfectly in Windows but it doesnt work for MAC and gives a 5948 error. I had added a field for the image in the userform with a button to add the image and the final submit button. The add button should allow the user to insert any size image from the local folder.
The code I was using is given below:
Dim ImagePath As String
Private Sub CMDAddImage_Click()
Dim objFileDialog As Office.FileDialog
Set objFileDialog = Application.FileDialog(MsoFileDialogType.msoFileDialogFilePicker)
With objFileDialog
.AllowMultiSelect = False
.ButtonName = "File Picker"
.Title = "File Picker"
If (.Show > 0) Then
End If
If (.SelectedItems.Count > 0) Then
Call MsgBox(.SelectedItems(1))
ImagePath = .SelectedItems(1)
End If
End With
Image1.Picture = LoadPicture(ImagePath)
End Sub
And the code in submit button was:
Dim objWord
Dim objDoc
Dim objShapes
Dim objSelection
'Set objSelection = ActiveDocument.Sections
'objSelection.TypeText (vbCrLf & "One Picture will be inserted here....")
ActiveDocument.Bookmarks("Field04").Select
Set objShapes = ActiveDocument.InlineShapes
objShapes.AddPicture (ImagePath)
End
End Sub
Can someone please help me edit the code for mac. In mac it does not allow to add the file.
You should check out the suggestion made by #JohnKorchok in a comment to your previous question - insert an image Content Control in your document instead, and throw away the VBA.
But if you need to keep using VBA and a UserForm...
Application.FileDialog is not available on Mac.
Application.GetOpenFileName is not avaialble from Word (it's an Excel thing).
Application.Dialogs does not do the same thing as GetOpenFileName so the user experience will be rather different, but at its simplest, you can use it like this:
With Application.Dialogs(wdDialogFileOpen)
' .Display = -1 for "OK" ("Open" in this case)
' .Display = 0 for "Cancel"
' (THere are other possible return values
' but I do not think they are applicable here)
If .Display = -1 Then
ImagePath = .Name
End If
End With
or if you prefer, the lengthier
Dim dlg As Word.Dialog
Set dlg = Application.Dialogs(wdDialogFileOpen)
With dlg
If .Display = -1 Then
ImagePath = .Name
End If
End With
Set dlg = Nothing
However, this dilaog does not let you specify file types or any kind of filtering, a starting folder etc. Attempts to set Finder search criteria via something like
.Name = "(_kMDItemFileName = ""*.jpg"")"
.Update
before the .Display either can't work or need different syntax.
Further, the Apple dialog may start with its
own filtering set up so the user will have to click Options to enable All Files. You don't know what file type the user will choose so you will need to deal with that.
An alternative is to invoke Applescript. For this, it appears that you can still use the VBA MacScript command, which means that you can put all the script in your VBA file. If that does not work, then unfortunately you have to use AppleScriptTask which would require you to work some more on the Script and install the script in the correct folder on every Mac where you need this feature.
Here's the code I used - you would probably need to wrap everything up in another function call and use conditional compilation or other tests to call the correct routine depending on whether the code is running on Mac or Windows
Private Sub CMDAddImage_Click()
Dim s As String
Dim sFileName As String
On Error Resume Next
s = ""
' set this to some other location as appropriate
s = s & "set thePictureFoldersPath to (path to pictures folder)" & vbNewLine
s = s & "set applescript's text item delimiters to "",""" & vbNewLine
s = s & "set theFile to ¬" & vbNewLine
' add the image file types you want here
s = s & "(choose file of type {""png"",""jpg""} ¬" & vbNewLine
s = s & "with prompt ""Choose an image to insert."" ¬" & vbNewLine
s = s & "default location alias thePictureFoldersPath ¬" & vbNewLine
s = s & "multiple selections allowed false) as string" & vbNewLine
s = s & "set applescript's text item delimiters to """"" & vbNewLine
' choose file gives as an AFS path name (with colon delimiters)
' get one Word 2016/2019 will work with
s = s & "posix path of theFile"
sFileName = MacScript(s)
If sFileName <> "" Then
' Maybe do some more validation here
ImagePath = sFileName
Image1.Picture = LoadPicture(ImagePath)
End If
End Sub

Bug in MS Word's VBA Document Collection, not sure why this workaround crashes

MS Word 2010 has a bug in its ability to correctly maintain (of all things) the documents collection (link to earliest report found - social.msdn.microsoft.com).
As far as I can tell this bug only impacts Word 2010. Although the documents collection is not maintained, it turns out that the Application.Windows collection is. Hence, for Word 2010 the following code based on the original reporters investigation (see below) and this question on answers.microsoft.com seem to provide a good alternative to the buggy documents collection:
' PURPOSE:
' Return a document collection, work-around for Word 2010 bug
Public Function docCollection() As VBA.Collection
Dim indexOfAvailableAppWindows As Long
Dim resultDoc As VBA.Collection
Dim foundDoc As Word.Document
Set resultDoc = New Collection
For indexOfAvailableAppWindows = 1 To Application.Windows.Count
If Application.Windows(indexOfAvailableAppWindows).Document.Type = wdTypeDocument Then
Set foundDoc = Application.Windows(indexOfAvailableAppWindows).Document
resultDoc.Add foundDoc, foundDoc.FullName ' Can NOT use 'name' - fails to be unique
End If
Next indexOfAvailableAppWindows
Set docCollection = resultDoc
Set resultDoc = Nothing
End Function
However, and here's my question, the above code some times fails with error 457 This key is already associated with an element of this collection on line resultDoc.Add foundDoc, foundDoc.FullName. What circumstances could possibly lead to such a failure?
So far the code has only failed on 1 PC running Word 2016. I don't have access to the PC. I did discover that the original version used Document.Name as the key (which was not always unique, so this was changed to Document.Full name)
Assumptions:
Document.FullName will always be unique
Things I've ruled out:
use of Split Window
opening downloaded documents (protected window documents are not counted)
Code that can be used to demonstrate the issue in Word 2010 (adapted from the original report).
' Function Credit Bas258 (https://social.msdn.microsoft.com/profile/bas258)
Function test01() As Boolean
'Adapted to VBA from original: 03-11-2012 1.0 Visual Studio 2008 VB code
Dim oDoc As Word.Document
Dim oDoc0 As Word.Document
Dim oDoc1 As Word.Document
Dim oDoc2 As Word.Document
Dim oDoc3 As Word.Document
Dim oDoc4 As Word.Document
Dim n As Integer
Set WDapp = Application
With WDapp
Debug.Print (Format(Now(), "dd-MM-yyyy") & " MS Office " & .Application.Version)
Set oDoc0 = .Documents.Add: Debug.Print ("add " & oDoc0.Name)
Set oDoc1 = .Documents.Add: Debug.Print ("add " & oDoc1.Name)
Set oDoc2 = .Documents.Add: Debug.Print ("add " & oDoc2.Name)
Set oDoc3 = .Documents.Add: Debug.Print ("add " & oDoc3.Name)
Set oDoc4 = .Documents.Add: Debug.Print ("add " & oDoc4.Name)
For n = 1 To .Documents.Count
Debug.Print ("count " & n & " " & .Documents(n).Name)
Next n
Debug.Print ("close " & oDoc4.Name)
oDoc4.Close
Set oDoc4 = Nothing
Debug.Print ("close " & oDoc3.Name)
oDoc3.Close
Set oDoc3 = Nothing
For n = 1 To .Documents.Count
Debug.Print ("count " & n & " " & .Documents(n).Name)
Next n
n = 0
For Each oDoc In .Documents
n = n + 1
Debug.Print ("doc " & n & " " & oDoc.Name)
Next oDoc
n = 0
For Each oWin In .Windows
n = n + 1
Debug.Print ("win " & n & " " & oWin.Document.Name)
Next oWin
Debug.Print ("close " & oDoc2.Name)
oDoc2.Close
Set oDoc2 = Nothing
Debug.Print ("close " & oDoc1.Name)
oDoc1.Close
Set oDoc1 = Nothing
Debug.Print ("close " & oDoc0.Name)
oDoc0.Close
Set oDoc0 = Nothing
End With
Set WDapp = Nothing
End Function
This is NOT going to be the accepted answer. Although it does answer the broader question (what could cause this code to crash) it not address the specific crash that I am trying to isolate. Either way there appears to be another bug in MS Word which seemed to be worth capturing for the common good.
This time the bug is with the Windows Collection; and joy of joys, I've confirmed it for both Word 2010 and Word 2016 - both 64 bit apps.
Steps to reproduce the bug are as follows:
In windows explorer enable the Preview Pane
Select a word document FILE so that it is 'previewed'
Open the same document (without losing the 'preview view')
Run the code from the OP, it will crash on this line:
If Application.Windows(indexOfAvailableAppWindows).Document.Type = wdTypeDocument Then
It turns out that when a word file is being previewed the Application.Windows.Count property is incremented by the preview; however any attempt to get a property of that window results in Error 5097 - Word has encountered a problem.
So, an improvement to the original code would therefore be:
' PURPOSE:
' Returns a healthy document collection
' - work-around for Word 2010 bug
' - excludes hits from Windows Explorer Preview Pane
Public Function docCollection() As VBA.Collection
On Error GoTo docCollectionError
Dim indexOfAvailableAppWindows As Long
Dim resultDoc As VBA.Collection
Dim foundDoc As Word.Document
Set resultDoc = New Collection
' Use index instead of Each to avoid For Loop Not initialised error, preview pane
For indexOfAvailableAppWindows = 1 To Application.Windows.Count
If Application.Windows(indexOfAvailableAppWindows).Document.Type = wdTypeDocument Then
Set foundDoc = Application.Windows(indexOfAvailableAppWindows).Document
resultDoc.Add foundDoc, foundDoc.FullName ' Key must NOT be 'name' - fails to be unique see BUG: 1315
End If
lblSkipThisDoc:
Next indexOfAvailableAppWindows
Set docCollection = resultDoc
Set resultDoc = Nothing
Exit:
Exit Function
docCollectionError:
If Err.Number = 5097 Then ' An open document is also open in the Windows Explorer Preview Pane
Err.Clear
Resume lblSkipThisDoc ' - skip this window
End If
If Err.Number = 457 Then ' Key is already used, but HOW? Unknown cause of error
Err.Clear
Stop 'Resume lblSkipThisDoc ' Is it safe to skip this document, why is there a duplicate?
End If
End Function
There is a setting in MS Word that enables 1 document to be viewed in 2 windows. In Word 2010 it is under the View (Tab): Window > New Window
The new window is counted separately in Application.Windows.Count and returns the same document object, hence the key exists.
For indexOfAvailableAppWindows = 1 To Application.Windows.Count ' <<< New Windows is counted
If Application.Windows(indexOfAvailableAppWindows).Document.Type = wdTypeDocument Then
Set foundDoc = Application.Windows(indexOfAvailableAppWindows).Document
resultDoc.Add foundDoc, foundDoc.FullName ' <<< fails to add 2nd instance of document
End If
So... the solution would likely involve checking the caption of the document:
IMMEDIATE WINDOW:
?foundDoc.Windows(1).Caption
Document2:1

Access 2013, Module Not Generating Fields on Word 2013 Document, but Function Within Main Form Does

I have a simple Access 2013 database that currently has one table, and one form for inputting data. I input data using the form, things like first name, last name, etc. I then have the database calling a function that takes these values, and places them on a word document in specific areas, (similar to mail merge, but mail merge doesn't suit my exact needs.) The function then converts a copy of that word document to a .pdf, and saves it in a location that is pre-defined.
I currently have the function tied to a button that is on the form. Everything works fine now, and I would like to break the soon-to-be large amount of code that will follow into modules; however, this is where I am having the issue. When I place this function in a module, it does not populate all of the form fields on the word document. It only populates one or two fields, not all of them. If I place the code back in a function that is on the main form, it works just fine.
I do not get any errors either way. The .pdf is created and stored exactly where it is supposed to be, but if the button calls the module, it doesn't populate all of the fields. If the button calls the function within the same form, it works like a champ. I will post a shortened version of the code below.
My initial thoughts are that perhaps I am not calling the module correctly, but at this point, I am lost. I have tried passing the values as 'Function Memo(LN, FN, srcFile) As String', labeling individually 'As String', but I can't seem to get it to work.
Function Memo(LN, FN, srcFile)
Dim appword As Object
Dim doc As Object
Dim Path As String
Dim pdfFileName As String
Dim folderName As String
Dim directory As String
Path = srcFile
folderName = LN & ", " & FN
directory = Application.CurrentProject.Path & "\" & folderName
pdfFileName = directory & "\" & folderName & " 2015 Memo" & ".pdf"
If Dir(directory, vbDirectory) = "" Then
MkDir (directory)
Else
End If
On Error Resume Next
Error.Clear
Set appword = GetObject(, "word.application")
If Err.Number <> 0 Then
Set appword = CreateObject("Word.Application")
appword.Visible = False
End If
Set doc = appword.Documents.Open(Path, , True)
With doc
.FormFields("TextFN1").Result = FN
.FormFields("TextMI1").Result = MI
.FormFields("TextLN11").Result = LN
.ExportAsFixedFormat pdfFileName, 17
appword.Visible = False
Set doc = appword.Documents.Close()
appword.Quit SaveChanges:=False
End With
Set doc = Nothing
Set appword = Nothing
End Function
Wow. Silly me. After some additional exploratory surgery on the code, I found my problem. The issue is that a few of my variables did not have unique names. Problem solved.

How to uniquely identify an Outlook email as MailItem.EntryID changes when email is moved

My company uses a single email address for customers to send requests and orders to. we created an Access database that import emails into a table. The table creates it's own unique identifier for each email imported but is not supposed to import an email twice. The system was working as we were only concerned with emails coming into the inbox and didn't need anything more than that.
However we now need to know the "flow", "traffic" and "workload" of the email pool that this account is. The email that comes into the inbox is categorized and then moved to a folder called "my_tasks" and a subfolder the folder named as 1 of the four CSRs to be worked on by a manager. This email is then dealt with and the CSR moves it to a subfolder under another folder called "Completed".
So email comes into Inbox, gets moved to my_tasks\joeblow is dealt with and gets moved to Completed\Canada.
Currently I have code that iterates through the folders and finds each email, grabs the fields we want to store and then inserts them into the table. All of this is done in Access through VBA code.
Private Sub ImportEmailItem(objMailItem As Outlook.MailItem)
On Error GoTo ImportEmailItem_Error
' Set up DAO objects
Dim rstMB As DAO.Recordset
Dim dskippedFolderMailCount As Double
Dim strSQLrMB As String
strSQLrMB = "SELECT * FROM tblMailBox WHERE OLID='" & objMailItem.EntryID & "'"
Set rstMB = CurrentDb.OpenRecordset(strSQLrMB)
With rstMB
If Not .BOF And Not .EOF Then
.MoveLast
.MoveFirst
While (Not .EOF)
If .Updatable Then
.Edit
rstMB!Subject = objMailItem.Subject
rstMB!Body = objMailItem.Body
Call subCategory(objMailItem)
rstMB!CSR = IIf(Len(objMailItem.Categories) = 0, "Unassigned", objMailItem.Categories)
rstMB!Importance = objMailItem.Importance
rstMB!Region = objMailItem.Parent
rstMB!DateModified = objMailItem.LastModificationTime
rstMB!FlagCompleted = objMailItem.FlagRequest
rstMB!folder = objMailItem.Parent
rstMB!Path = objMailItem
.Update
End If
.MoveNext
Wend
Else
rstMB.AddNew
rstMB!olid = objMailItem.EntryID
rstMB!ConversationIndex = objMailItem.ConversationIndex
rstMB!ConversationID = objMailItem.ConversationID
rstMB!Conversation = objMailItem.ConversationTopic
rstMB!To = Left(objMailItem.To, 250)
rstMB!CC = Left(objMailItem.CC, 250)
rstMB!Subject = objMailItem.Subject
rstMB!Body = objMailItem.Body
Call subCategory(objMailItem)
rstMB!CSR = IIf(Len(objMailItem.Categories) = 0, "Unassigned", objMailItem.Categories)
rstMB!Importance = objMailItem.Importance
rstMB!From = objMailItem.SenderEmailAddress
rstMB!Region = objMailItem.Parent
rstMB!DateReceived = objMailItem.ReceivedTime
rstMB!DateSent = objMailItem.SentOn
rstMB!DateCreated = objMailItem.CreationTime
rstMB!DateModified = objMailItem.LastModificationTime
rstMB!FlagCompleted = objMailItem.FlagRequest
rstMB!folder = objMailItem.Parent
rstMB.Update
End If
.Close
End With
ImportEmailItem_Exit:
Set rstMB = Nothing
Exit Sub
ImportEmailItem_Error:
Debug.Print Err.Number & " " & Err.Description
Select Case Err.Number
Case 91
Resume Next
Case 3022
Resume Next
Case -2147221233
MsgBox "Customer Care Account Name is incorrect, please enter the Mail box name as seen in your outlook client.", vbOKOnly, "Mail Folder Name Error"
Me.txtMailAccountName.SetFocus
Exit Sub
Case Else
MsgBox "Error #: " & Err.Number & " " & Err.Description '& Chr(13) + Chr(10) & IIf(mail.Subject Is Null, "", mail.Subject) & " " & IIf(mail.ReceivedTime Is Null, "", mail.ReceivedTime)
' DoCmd.RunSQL "INSERT INTO tblImportReport(ImportDate,ImportFolder,ImportResult,ImportEmailCount) VALUES (#" & Now() & "#,'" & mailFolder & "', 'Error " & Err.Number & "', " & dMailCount & ")"
Resume Next 'cmdImportEmail_Exit
End Select
End Sub
Is there a way to uniquely identify an email with a single field no matter whether it has been moved or not?
I have an idea of what I could do to make sure I have the right email and get the original entry in my database. If there was no other way I could concatenate fields together to form a unique field and then get the database table's primary key field value.
You can use the PR_SEARCH_KEY property (DASL name http://schemas.microsoft.com/mapi/proptag/0x300B0102) - it does not change when a message is moved. It can be accessed through MailItem.PropertyAccessor.GetProperty, but unfortunately you cannot use PT_BINARY properties in Items.Find/Restrict.
You can also set your own named property using MailItem.UserProperties.
UPDATE:
For PR_SEARCH_KEY, see https://msdn.microsoft.com/en-us/library/office/cc815908.aspx.
MaillItem.UserProperties can be used from anywhere - Outlook Object Model is Outlook Object Model whether it is used from inside Outlook or externally from Excel. Keep in mind that setting a user property and saving the item will change its last modified date.
If you want to stick to PR_SEARCH_KEY, to be be able to sort on it, you might want to look at Redemption (I am its author) - its RDOFolder.Items.Find / Restrict methods allow PT_BINARY properties in its queries, e.g. "http://schemas.microsoft.com/mapi/proptag/0x300B0102" = '89F75D48972B384EB2C50266D1541099'
Here is VBA code tested in MS Access 2013 to extract the PR_SEARCH_KEY from an Outlook.MailItem and convert to a string:
Public Function strGetMailItemUniqueId( _
olMailItem As Outlook.MailItem _
) As String
Dim PR_SEARCH_KEY As String
PR_SEARCH_KEY = "http://schemas.microsoft.com/mapi/proptag/0x300B0102"
Dim olPA As Outlook.PropertyAccessor
Set olPA = olMailItem.PropertyAccessor
Dim vBinary As Variant
vBinary = olPA.GetProperty(PR_SEARCH_KEY)
strGetMailItemUniqueId = olPA.BinaryToString(vBinary)
End Function
In Microsoft Outlook versions like 2007, 2010, Office 365 etc. there is a property Message-ID in the headers section of the email.
You can use this property to uniquely identify an email.

Software Requirements Reviews with MS Word - How do I get metrics in an automated way?

Let's say I have a requirements document in MS Word, and someone else reviews it an provides a list of issues found using the "Track Changes" feature.
Is there a way to extract "how many major/minor issues were found during the review?" using an automated script - for metrics purposes?
I see CodeCollaborator has some MS Word integration, but it doesn't seem to know how to look inside Word to extract the tracked changes data. It just launches the document.
I did once write a Word macro that extracts the comments to a separate document, you are welcome to try adapting this to your purposes, if you have trouble then reply here and I can give you a hand with making changes.
Public Sub PROCESS_COMMENTS()
Dim strReplaceText As String
Dim myPar As Paragraph
Dim strCurrentColumn As String
Dim i As Integer
Dim Com As Comment
Application.ScreenUpdating = False
' set the input and output docs.
Set inDoc = ActiveDocument
' check we have comments to process in the original document
If inDoc.Comments.Count < 1 Then
MsgBox "No comments in the document"
Exit Sub
End If
' comments exist so create new document
Set outDoc = Documents.Add
Set outRange = outDoc.Content
outDoc.Range.InsertAfter "List of Comments:"
outDoc.Paragraphs(outDoc.Paragraphs.Count).Style = outDoc.Styles("Heading 1")
outDoc.Range.InsertParagraphAfter
' cycle through comments, inserting them in the new document
' display the new document and refresh
outDoc.Activate
Application.ScreenRefresh
For Each Com In inDoc.Comments
outRange.InsertAfter "[" & Com.Author & " - " & Com.Initial & Com.Index & "] "
outDoc.Paragraphs(outDoc.Paragraphs.Count).Range.Font.Bold = True
outDoc.Range.InsertParagraphAfter
outRange.InsertAfter Com.Range.Text
outDoc.Paragraphs(outDoc.Paragraphs.Count).Range.Font.Bold = False
Set myRange = Com.Scope
outDoc.Range.InsertParagraphAfter
outDoc.Range.InsertParagraphAfter
Next
Application.ScreenUpdating = True
Set outDoc = ActiveDocument
End Sub