How to find if a word is part of a cross-reference by vba

[scienceguy]

Hello,

I need to write a VBA macro that will determine if a word is part of a cross-reference. I am doing this on multiple documents. I wrote a simple macro that goes word by word and finds all that have a blue font as a test case, to convince myself I can get the words. Now, I'd like to know if that word is associated with a cross-reference. Here is the code I have so far:

Sub BatchFindCR()
  
  Dim objDoc As Document
  Dim objSingleWord As Range
  Dim strFile As String, strFolder As String
 
  strFolder = "C:\Users\roy\Desktop\test files\"
  strFile = Dir(strFolder & "*.docx", vbNormal)
 
  While strFile <> ""
  Set objDoc = Documents.Open(FileName:=strFolder & strFile)
 
  For Each objSingleWord In objDoc.Words
    If objSingleWord.Font.ColorIndex = wdBlue Then
        MsgBox "Found: " & strFile
        Exit For
    End If
    'is word part of a cross-reference?
        'code
     
   '
    
  Next objSingleWord
 
  objDoc.Save
  objDoc.Close
  strFile = Dir()
  Wend
  
  MsgBox "Done!"
  
End Sub

Can someone help me get going, please?

Thanks,
Roy

[macropod]

Why not simply loop through all the cross-references? For example:

Sub Demo()
Dim Fld As Field, StrWrd As String
StrWrd = InputBox("Input the string to find")
With ActiveDocument
  For Each Fld In .Fields
    With Fld
      If .Type = wdFieldRef Then
        If InStr(.Result, StrWrd) > 0 Then
          MsgBox StrWrd & " can be found in a field"
          Exit Sub
        End If
      End If
    End With
  Next
End With
End Sub

There are also far more efficient ways of finding coloured text...

[Guessed]

For what purpose is this being performed? Are you searching for a specific word or any old word that happens to be blue?

Going word by word is very slow and there will likely be a faster way. Two alternative approaches would be to use a find for blue text or perhaps loop through the fields to see if the word occurs there.

[scienceguy]

Thank you, "Guessed." Sorry, I should have given more context. I work in a group that publishes internal documents. When someone authors a document, he/she changes the font color to blue for a words that need a cross-reference added. So, I was trying to figure out a way to determine which blue words already had their cross-reference added and perhaps, more importantly, which ones were lacking. Does this make more sense what I'm trying to do?

[scienceguy]

Thanks, Paul! A need to search all words in the document. There are two criteria, is the font color of the word blue and does the work contain a cross-reference.

[macropod]

Ordinarily, a word cannot 'contain' a cross-reference; it can be part of a cross-reference and/or contained within a bookmarked range that is used for a cross-reference. Please clarify your intent.

[scienceguy]

Hi Paul, I'm assuming "part of a cross-reference." We would highlight the word in Microsoft Word, select Cross Reference and select the Numbered Item. Is that what you mean by "part of a cross-reference?"

[macropod]

If you've inserted a cross-reference that way, your blue text would have been replaced by the cross-reference, which would most likely no longer be blue - unless someone has gone back and formatted the cross-references in blue. Hence, all you should need do is find any remaining instances of blue text. Supposing you do find such text (of which I'm assuming there may be multiple instances in a single document), what do you want to do about it?

[scienceguy]

Thanks, Paul, for the continued help. Ok, what would be most effective way to search for words in a blue font? At this point, I just need to know if the doc has blue text words and what the words are. For now, a message box with the word + filename would be fine.

[macropod]

Try:

Sub CheckDocuments()
Application.ScreenUpdating = False
Dim strFolder As String, strFile As String, strDocNm As String, wdDoc As Document, i As Long, StrTxt As String
strDocNm = ActiveDocument.FullName
strFolder = GetFolder
If strFolder = "" Then Exit Sub
strFile = Dir(strFolder & "\*.doc", vbNormal)
While strFile <> ""
  If strFolder & "\" & strFile <> strDocNm Then
    i = 0: StrTxt = ""
    Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
    With wdDoc
      With .Range
        With .Find
          .ClearFormatting
          .Replacement.ClearFormatting
          .Text = ""
          .Replacement.Text = ""
          .Forward = True
          .Wrap = wdFindStop
          .Format = True
          .Font.ColorIndex = wdBlue
          .Execute
        End With
        Do While .Find.Found
          If .Fields.Count = 0 Then
            i = i + 1: StrTxt = StrTxt & vbCr & .Text
          End If
          If .Information(wdWithInTable) = True Then
            If .End = .Cells(1).Range.End - 1 Then
              .End = .Cells(1).Range.End
              .Collapse wdCollapseEnd
              If .Information(wdAtEndOfRowMarker) = True Then
                .End = .End + 1
              End If
            End If
          End If
          If .End = ActiveDocument.Range.End Then Exit Do
          .Collapse wdCollapseEnd
          .Find.Execute
        Loop
      End With
      If i > 0 Then MsgBox i & " instance(s) found in " & .Name & ":" & StrTxt
      .Close False
    End With
  End If
  strFile = Dir()
Wend
Set wdDoc = 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

[scienceguy]

Paul, this is amazing! Thank you!!!! My only need though, is to know what the word was that had a blue font. Would that be hard to get?

[macropod]

Code updated.

[scienceguy]

Paul, thank you SO MUCH for your help and coaching! You're spirit of volunteerism and guidance is tremendous. You're a credit to the forum! Best wishes, Roy