PDA

View Full Version : [SOLVED:] Word VBA count all cross references in main body of the document



olakayt
03-05-2019, 04:14 PM
Hi all

New to word VBA, I need a macro that can all all cross reference (field codes) in a word document with a message box of the numbers.

Is this possible, if so, how.

Thanks in advance.

E.

macropod
03-05-2019, 05:16 PM
Please clarify: Do you need a count of all fields, or only of cross-reference fields?

olakayt
03-05-2019, 09:38 PM
Please clarify: Do you need a count of all fields, or only of cross-reference fields?

Need a count of all the cross reference fields.

Thanks

macropod
03-05-2019, 10:47 PM
You can get that without VBA, by pressing Alt-F9 to expose field codes in the document, then using Find with:
Find = ^d REF
and/or
Find = ^d PAGEREF
The first will return a count of cross references to the referenced text; the second will return a count of cross references to their pages.

olakayt
03-06-2019, 12:48 AM
You can get that without VBA, by pressing Alt-F9 to expose field codes in the document, then using Find with:
Find = ^d REF
and/or
Find = ^d PAGEREF
The first will return a count of cross references to the referenced text; the second will return a count of cross references to their pages.

Thanks for this, however, I have about 400 documents that I need to count the number of cross references in. Ideally, I would like to enter the file path of the documents and get an excel spreadsheet with the document name in one column and the number of Xrefs in another column.
I am not sure what the best approach for this.

Thanks for your help.
E

macropod
03-06-2019, 12:54 AM
Your first post referred only to:

cross reference (field codes) in a word document with a message box of the numbers
not in "about 400 documents". Kindly provide full details of what you require - doubtless not 400 message boxes - before someone wastes time coding for something different.

olakayt
03-06-2019, 04:18 AM
Apologies for the changes in the actual request. This is a developing request and I now have the full requirement for the VBA. Need to be able to count the number of cross references in documents without actually opening them.

Scenario - documents saved in a folder, insert the folder name in the code, code loops through all document and create a table either in word or Excel with the document name and the number of Xrefs found.

I am open to any suggestions of how to get this done.

Hope this makes sense.

Once again, my apologies.
E

macropod
03-06-2019, 02:14 PM
Try the following Excel macro. It includes a folder browser so you can select the folder to process.

Sub GetDocRefs()
'Note: this code requires a reference to the Word object model.
'See under the VBE's Tools|References.
Application.ScreenUpdating = False
Dim wdApp As New Word.Application, wdDoc As Word.Document
Dim strFolder As String, strFile As String, f As Long, i As Long, r As Long
strFolder = GetFolder: If strFolder = "" Then GoTo ErrExit
strFile = Dir(strFolder & "\*.doc", vbNormal)
While strFile <> ""
Set wdDoc = wdApp.Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
r = r + 1: i = 0
With wdDoc
For f = 1 To .Fields.Count
Select Case .Fields(f).Type
Case wdFieldPageRef, wdFieldRef: i = i + 1
End Select
Next
.Close SaveChanges:=False
End With
ActiveSheet.Range("A" & r).Value = strFile
ActiveSheet.Range("B" & r).Value = i
strFile = Dir()
Wend
wdApp.Quit
Set wdDoc = Nothing: Set wdApp = Nothing
Application.ScreenUpdating = True
End Sub

Function GetFolder() As String
Dim oFolder As Object
GetFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
End Function

olakayt
03-07-2019, 09:08 AM
Thanks, this works perfectly.:friends::friends::friends:

olakayt
03-07-2019, 01:02 PM
Hi there, is it possible to add another column to count number number of pages.

Thanks

macropod
03-07-2019, 02:32 PM
To do that, you might change:

.Close SaveChanges:=False
End With
ActiveSheet.Range("A" & r).Value = strFile
ActiveSheet.Range("B" & r).Value = i
to:

ActiveSheet.Range("A" & r).Value = strFile
ActiveSheet.Range("B" & r).Value = i
ActiveSheet.Range("C" & r).Value = .ComputeStatistics(wdStatisticPages)
.Close SaveChanges:=False
End With