locked
Macro for Searching Word 2007 Text Boxes for Wildcard Text and Printing Found Text to File RRS feed

  • Question

  • I'm trying to write a macro for searching Word 2007 Text Boxes for Wildcard Text (/[A-Z][0-9][A-Z]) and printing found text to a text file.  Here's my start at that (using some similar code found on the web).  What I can't get right is how to print the found text to the text file.  Of course any other parts of what I've done may be messed up as well. 

    Help would be much appreciated.  Thanks!!!!!

     

    'Open the file for writing found text entries (strFilename has been set to the name and extension of the text file where I want to collect the found items)

        Open strFilename For Append As #1
        
            
     For Each myStoryRange In ActiveDocument.StoryRanges
         If myStoryRange.StoryType <> wdMainTextStory Then
            
            With myStoryRange.Find
     
            .Text = "/[A-Z][0-9][A-Z]"
            .Forward = True
            .Wrap = wdFindContinue
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchAllWordForms = False
            .MatchSoundsLike = False
            .MatchWildcards = True

    ' I think that the printing thing should go here, but anything I've tried doesn't work.


           End With

     

        Do While Not (myStoryRange.NextStoryRange Is Nothing)
               Set myStoryRange = myStoryRange.NextStoryRange

            With myStoryRange.Find
            .Text = "/[A-Z][0-9][A-Z]"
            .Forward = True
            .Wrap = wdFindContinue
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchAllWordForms = False
            .MatchSoundsLike = False
            .MatchWildcards = True

    ' I think that another printing thing should go here, but anything I've tried doesn't work.
          
        Loop
       End If
       Next myStoryRange
       
       Close #1


    Jim
    Tuesday, January 27, 2009 1:32 AM

Answers

  • I figured out how to do this:

    --------

    Sub Write_File_Listing_Codes()
    '
    ' Write_File_Listing_Codes Macro
    '
    '
        Dim strPrintString As String
        Dim strNewPrintString As String
        Dim strDirectory As String
        Dim strFilename As String
        Dim strThisFilename As String
        Dim intj As Integer
       
       
        strPadString = "                             "
       
    ' Get the current document path
        strThisFilename = ActiveDocument.FullName
        strDirectory = ActiveDocument.Path
    ' Make sure this file is not unnamed
            If Len(strDirectory) > 0 Then
               strFilename = strDirectory & "\" & "AlphaElementsInDwgs.txt"
               Else: strFilename = "C:\Temp\Elements.txt"
               End If
              
    ' Clear the old file if it exists

        Open strFilename For Output As #1
        Print #1, ""
        Close #1
       
    'Open the file for new entries

        Open strFilename For Append As #1
       
    For intj = 1 To ActiveDocument.Shapes.Count
        ActiveDocument.Shapes(intj).Select
        Selection.WholeStory
        With Selection.Find
            .Text = "/[A-Z][0-9][A-Z]"
            .Replacement.Text = ""
            .Forward = True
            .Wrap = wdFindContinue
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With
        Selection.Find.Execute
    '    MsgBox Selection.Text ' This pops up a Message Box that displays the text in each text box as it is found
        Print #1, Selection.Text

    Next intj

    Close #1

    ' Finished; go back to the start of the document and quit

        Selection.HomeKey Unit:=wdStory
       
    End Sub


    Jim
    • Marked as answer by Tim Li Monday, February 2, 2009 9:55 AM
    Friday, January 30, 2009 5:03 PM