# Search closed word document and excel file without opening and check for match



## bradyboyy88 (Jan 10, 2017)

Hi,

I am wondering if there is a way to use the find keyword function in a word document and excel file without actually opening it using vba?


----------



## HackSlash (Jan 10, 2017)

I will have to assume you mean "Opening in Word" or "Opening with Excel" because the act of loading file contents in to memory is called "Opening". File contents needs to be in memory to perform string evaluation. You can attempt to load the raw contents of a word file or excel file in to memory and do your analysis but it won't be easy. Crack open the file you are talking about with a good text editor or "Hex editor" if you want to see what I mean. Using the Word API from VBA allows you to use the "find" function. That is what the "find" function is. Without the Word or Excel API there is no "Find" function. You can use the "Find" function of Excel on the text from a Word document but you need to get that text string out of the file somehow.

Notice that the most basic way to load file contents in to memory is a command called "Open"

https://stackoverflow.com/questions/11528694/read-parse-text-file-line-by-line-in-vba


----------



## bradyboyy88 (Jan 10, 2017)

HackSlash said:


> I will have to assume you mean "Opening in Word" or "Opening with Excel" because the act of loading file contents in to memory is called "Opening". File contents needs to be in memory to perform string evaluation. You can attempt to load the raw contents of a word file or excel file in to memory and do your analysis but it won't be easy. Crack open the file you are talking about with a good text editor or "Hex editor" if you want to see what I mean. Using the Word API from VBA allows you to use the "find" function. That is what the "find" function is. Without the Word or Excel API there is no "Find" function. You can use the "Find" function of Excel on the text from a Word document but you need to get that text string out of the file somehow.
> 
> Notice that the most basic way to load file contents in to memory is a command called "Open"
> 
> https://stackoverflow.com/questions/11528694/read-parse-text-file-line-by-line-in-vba



So how would you approach this if you did not want to load the word or excel api? I am just worried about resource usage of this program. I need to go through every excel file and word document in a subdirectory to find if it contains a certain keyword and if it does then I am basically saving the hyperlink to another excel file.  . There are hundreds of these files so I just wanted to approach this in the quickest and resource friendly solution possible so I thought a function similar to excel4macro that lets you read from a closed workbook existed in a search functionality. I am open to suggestions.


----------



## HackSlash (Jan 10, 2017)

I have made a program that does something just like you say. It opens each workbook one by one, performs it's function, and then closes the workbook before moving on to the next one. Only one workbook is open at a time. My program takes a few minutes to run and I put a lot of work in to optimizing it. The slowest part is I\O from disk and there is no way to optimize that. It's limited by the read\write speed of your hardware and the functions of your software environment. In my case, I am accessing workbooks on a share and so I have network lag added to my run time. I use "FileSystemObject" which makes calls to the OS for finding the file and I use the built-in "Open" feature of excel because I wouldn't want to re-write either of those functions from scratch. 

If you want the absolute fastest then you need stop using VBA for excel and code your own Office file handlers in assembly language. You would be able to make something faster than the built-in Microsoft functions this way but it does require learning assembly language. 

It's the words that you are using that make this discussion difficult. excel4macro reads from a closed workbook by opening it. The act of reading a closed workbook is called opening. That's the problem I have with this line of questioning.


----------



## bradyboyy88 (Jan 10, 2017)

So any ideas what could be causing a 5792 run time error with application defined or object defined error? Only word documents in the folders so only the top if statement is being hit. If i remove the documents.open line then everything works but I need to open them so what might be leading to this error? It opens one document then hits the error basically. Also, for a recursive approach like this is it less optimized to createobject at this level or the nest ?


```
Sub Search()


    Dim FileSystem As Object
    Dim HostFolder As String


    HostFolder = Worksheets("Search Interface").Range("D2").Value


    Set FileSystem = CreateObject("Scripting.FileSystemObject")
    RecursiveFolderSearch FileSystem.GetFolder(HostFolder)


End Sub


Sub RecursiveFolderSearch(Folder)
    
    Dim SubFolder
    Dim File
    
    Dim obj
    Dim objDoc


    For Each SubFolder In Folder.SubFolders
        RecursiveFolderSearch SubFolder
    Next
    
    For Each File In Folder.Files


        'Check if word document
        If Right(File.Name, 4) = "docx" Or Right(File.Name, 4) = ".doc" Or Right(File.Name, 4) = "docm" Or Right(File.Name, 4) = "dotm" Then
        
            Set obj = CreateObject("Word.Application")
            obj.Visible = False
            Set objDoc = obj.Documents.Open(File.Path)
            
            
            'code to search for keyword
            
            
            obj.Quit
            Set obj = Nothing
            Set objDoc = Nothing
        End If
        
        'Check if excel document
        If Right(File.Name, 4) = "xlsm" Or Right(File.Name, 4) = "xlsx" Or Right(File.Name, 4) = ".xls" Or Right(File.Name, 4) = ".xlt" Then
            
            Set obj = CreateObject("Excel.Application")
            obj.Visible = False
            Set objDoc = obj.Workbooks.Open(File.Path)
            
            
            'code to search for keyword
            
            
            obj.Quit
            Set obj = Nothing
            Set objDoc = Nothing


        End If
    Next
    
End Sub
```


----------



## HackSlash (Jan 10, 2017)

Ok, 
There is a lot going on here. First thing I notice is "obj.Quit" will close word after each doc which is undesirable because then you have to wait for Word to open before you can open the next doc. If we find a Word file we will leave word open until we are done. It's also seen in the excel branch so if it opens an excel doc it will close excel when done. If we are running this macro from excel then the rug is pulled out from under us. 

In the Excel section we don't need to create an application object because we can use the default "Application" object. (Unless this macro is running from Word)

Here is something for you to try:


```
Sub RecursiveFolderSearch(Folder)
    
    Dim SubFolder As Object
    Dim File As Object

    Dim WordApp As Object
    Dim WordDoc As Object

    For Each SubFolder In Folder.SubFolders
        RecursiveFolderSearch SubFolder
    Next
    
    For Each File In Folder.Files
        Select Case Right(File.name, 4)
            Case "docx" Or ".doc" Or "docm" Or "dotm" 'Check if word document
                'If Word is open we will use it, if not we will open it
                On Error Resume Next
                Set WordApp = GetObject(, "Word.Application")
                On Error GoTo 0
                If WordApp Is Nothing Then Set WordApp = CreateObject("Word.Application")
                'WordApp.Visible = True
                Set WordDoc = WordApp.Documents.Open(File.Path)
            
            'code to search for keyword
            
                WordDoc.Close
                Set WordDoc = Nothing
            Case "xlsm" Or "xlsx" Or ".xls" Or ".xlt" 'Check if excel document
                Application.Workbooks.Open (File.Path)
                
            'code to search for keyword
                           
                Application.Workbooks(File.Path).Close savechanges:=False
        End Select
    Next
End Sub
```


----------



## bradyboyy88 (Jan 10, 2017)

I keep getting a type 13 mismatch error at 
	
	
	
	
	
	



```
Case "docx" Or ".doc" Or "docm" Or "dotm" 'Check if word document
```
 for some reason?

I like the changes you made though. Makes sense not to keep recreating the word api if I do not have to.


----------



## Leith Ross (Jan 10, 2017)

Hello bradyboyy88,

The syntax for the Select Case  is wrong. It should...


```
Select Case LCase(Right(File.name, 4))        ' Make everything lowercase.
            Case Is ="docx",".doc","docm","dotm"      'Check if word document
                'If Word is open we will use it, if not we will open it
                On Error Resume Next
                    Set WordApp = GetObject(, "Word.Application")
                On Error GoTo 0
                If WordApp Is Nothing Then Set WordApp = CreateObject("Word.Application")
                'WordApp.Visible = True
                Set WordDoc = WordApp.Documents.Open(File.Path)
            
            'code to search for keyword
            
                WordDoc.Close
                Set WordDoc = Nothing
            Case Is="xlsm","xlsx",".xls",".xlt"       'Check if excel document
                Application.Workbooks.Open (File.Path)
                
            'code to search for keyword
                           
                Application.Workbooks(File.Path).Close savechanges:=False
        End Select
```


----------



## bradyboyy88 (Jan 11, 2017)

The case syntax is much cleaner so thanks for that edit. That fixed the error but now it draws another. So stepping into code it runs through the first loop and opens the first word doc then closes it. Then it goes to open the next one in the loop and hits a 5792 run time error application defined or object defined error at Set WordDoc = WordApp.Documents.Open(File.Path) . This is the same error I ran into before under the original code. Not sure what it could be.


----------



## bradyboyy88 (Jan 11, 2017)

I still cant figure out why that line is tripping that error.


----------



## bradyboyy88 (Jan 10, 2017)

Hi,

I am wondering if there is a way to use the find keyword function in a word document and excel file without actually opening it using vba?


----------



## bradyboyy88 (Jan 11, 2017)

This is my test folder structure

Main Folder ---The Cat Man.docx & Subfolder
Subfolder --- The Cat Man 2.docx

To debug I tested out the File.Name at each part of the loop and the first iteration the File.Name returns the value The Cat Man.docx. Then the second iteration which is what is triggering the error shows ~$e Cat Man.docx. So this must be the error but its hard to tell what could be causing this problem. The word file has nothing wrong with it as I just created a new one for testing too and still getting the same problem.


----------



## Leith Ross (Jan 12, 2017)

Hello bradyboyy88,

I did a search online for error 5792. Here is link to the Microsoft Support Article You receive error messages when you start Word

This may help you identify the problem. Let me know what you discover.


----------



## bradyboyy88 (Jan 12, 2017)

Thanks for that. I figured the problem truly isnt that line. It has to do with File.Name so possibly FileSystemObject. Its a really strange occurance actually. As it cycles through files it seems to include files that are no longer in the folder and those files names become ~$ Then whatever the name is minums the first 2 letters since those two take their places. So I have put a if then statement to not try to open any files with Left(File.Name,2)="~$" and then everything runs fine. It is just really wierd to see that happening.


----------



## bradyboyy88 (Jan 13, 2017)

Leith Ross said:


> Hello bradyboyy88,
> 
> I did a search online for error 5792. Here is link to the Microsoft Support Article You receive error messages when you start Word
> 
> This may help you identify the problem. Let me know what you discover.



With that error fixed I am able to loop through hundreds of word document files but then I always seem to hit a point where my for each file i loop starts to draw a mismatch error at 

```
Set WordDoc = WordApp.Documents.Open(Filename:=File.Path, ReadOnly:=True)
```


So i set up error handling to say okay fine then skip that file and move on to the next file. But every single one starts to draw this mismatch error after one does it. Its strange because say I were to run the macro then 90 files would open great and the next 400 were mismatch errors. But I then run it again then 100 might be matches and 390 were mismatches. Could it be a memory leak? I do declare my objects outside of the routine as public so I do not have to keep re declaring them since this program is recursive. I can post my updated code if it helps.


----------



## NdNoviceHlp (Jan 13, 2017)

Please post your updated code. Dave


----------



## bradyboyy88 (Jan 13, 2017)

I put in a line number 10 for the one subroutine and that is where my error handler erl function returns. I have spent so much time trying to figure it out I would have been better going through all 8000 files by hand haha.

Here we go:


```
Option Explicit
Public Word As Variant
Public WordsToFind As New Collection
Public WordsFound As New Collection
Public PrintRow As Integer
Public SubFolderCount As Integer
Public FileCount As Integer
Public FileSystem As Object
Public FolderName As String
Public WordApp As Object
Public WordDoc As Object
Public strDate As String
Public ErrorCount As Integer


Sub Search()
    
    Dim HostFolder As String
    Dim WordsFound(1 To 7)
    Dim SearchWord As Integer
    
    'Clear any collection in memory
    Set WordsToFind = Nothing
    Set FileSystem = Nothing
    Set WordApp = Nothing
    Set WordDoc = Nothing
    
    'Create Word object
    Set WordApp = CreateObject("Word.Application")
    WordApp.Visible = False
    WordApp.DisplayAlerts = False
    
    'In case rerun clear public variable
    FileCount = 0
    SubFolderCount = 0
    ErrorCount = 0
    
    'Clear Current Results Page
    Worksheets("Results").Rows("2:" & Application.Max(Worksheets("Results").UsedRange.Rows.Count, 2)).Delete
    Worksheets("Results").OLEObjects.Delete
    
    'Setting the outputrow for printing results
    PrintRow = 2
    
    'Take sheet values used in program and assign to variables
    With Worksheets("Search Interface")
        
        HostFolder = .Range("D2").Value
        
        'Location of Search Words on Sheet . Code is also dynamic so just increase range if you want to add words
        For SearchWord = 8 To 12
            
            If Not IsEmpty(.Range("C" & SearchWord)) Then
                
                WordsToFind.Add .Range("C" & SearchWord)
            
            End If
            
        Next
        
    End With
    
    'If export spot is not empty then create folder which will then be zipped
    If Not IsEmpty(Worksheets("Search Interface").Range("D4").Value) Then
        
        With Worksheets("Search Interface").Range("D4")
        
            FolderName = "SearchFile-" & Format(Now(), "mmddyyyyhhmmss")
        
            strDate = Format(Now, " dd-mmm-yy h-mm-ss")
            FileNameZip = .Value & "\" & "SearchFileZip " & strDate & ".zip"
        
            'Make new Folder for zip
            MkDir .Value & "\" & FolderName
            
        End With
    End If
    
    
    'Run recursive folder search algorithm
    Set FileSystem = CreateObject("Scripting.FileSystemObject")
    RecursiveFolderSearch FileSystem.GetFolder(HostFolder)
  
    'If export spot is not empty then create folder which will then be zipped then delete original
    If Not IsEmpty(Worksheets("Search Interface").Range("D4").Value) Then
          
        With Worksheets("Search Interface").Range("D4")
            
            Zip_All_Files_in_Folder .Value & "\" & FolderName, .Value
            FileSystem.deletefolder .Value & "\" & FolderName
            
        End With
    End If
    
    'Clear Memory leaks
    WordApp.Quit
    Set WordsToFind = Nothing
    Set FileSystem = Nothing
    Set WordApp = Nothing
    Set WordDoc = Nothing
    
End Sub


Sub RecursiveFolderSearch(Folder)
    
    Dim SubFolder As Object
    Dim File As Object
    Dim PathName As String
    
    For Each SubFolder In Folder.SubFolders
          
        'This if then will help avoid shortcuts
        If Folder.Attributes <> 64 Then
            SubFolderCount = SubFolderCount + 1
            RecursiveFolderSearch SubFolder
        End If
    Next
    
    For Each File In Folder.Files
    
    'This is to get around MS stupid 255 character string limit
    If Len(File.Path) > 255 Then
    
        PathName = GetShortFileName(File.Path)
    
    Else
    
        PathName = File.Path
    
    End If
    
    'Just some summary statistics about how many folders and files were actually reviewed in total
    With Worksheets("Results")
        .Range("E1").Value = "Subfolder Count: " & SubFolderCount
        .Range("F1").Value = "Files Reviewed: " & FileCount
        .Range("G1").Value = "Match Count: " & PrintRow - ErrorCount - 2
        .Range("H1").Value = "Error Count: " & ErrorCount
    End With
    
    On Error GoTo ErrorHandler
        
        'Not sure what is causing this error. Maybe old files saved in memory?
        If Not Left(File.Name, 2) = "~$" Then
        
        FileCount = FileCount + 1
        Set WordsFound = Nothing
        
        Select Case LCase(Right(File.Name, 4))
            
            Case Is = "docx", ".doc", "docm", "dotm"  'Check if word document
                
10              Set WordDoc = WordApp.Documents.Open(Filename:=PathName, ReadOnly:=True)
                WordDoc.ActiveWindow.View.ReadingLayout = False
                                       
                'Select all and Check if word exists
                WordApp.Selection.WholeStory
                WordApp.Selection.Find.ClearFormatting
                    
                For Each Word In WordsToFind


                    With WordApp.Selection.Find
                        
                        .Text = Word
                        .Forward = True
                        .Wrap = 1
                        .Format = False
                        .MatchCase = False
                        .MatchWholeWord = True
                        .MatchWildcards = False
                        .MatchSoundsLike = False
                        .MatchAllWordForms = False
                        
                        If .Execute Then
                            
                            WordsFound.Add Word
                            
                        End If
                        
                    End With
                    
                Next
                
                If WordsFound.Count > 0 Then
                    
                'outputting the results
                    With Worksheets("Results")
                    
                        .Range("A" & PrintRow).Value = File.Name
                        
                        'This will merge the words found to one cell
                        For Each Word In WordsFound
                            
                            .Range("B" & PrintRow).Value = Word & "/" & .Range("B" & PrintRow).Value
                            
                        Next
                    
                        .Hyperlinks.Add Anchor:=.Range("C" & PrintRow), Address:=PathName, TextToDisplay:="Link - Click Here"
                        
                        'Check if interface wants you to embed file
                        If Worksheets("Search Interface").Shapes("EmbedCheckBox").ControlFormat.Value = 1 Then
            
                            .OLEObjects.Add Filename:=PathName, Link:=False, DisplayAsIcon:=True, Left:=.Range("D" & PrintRow).Left + 30, Top:=.Range("D" & PrintRow).Top + 3, Width:=50, Height:=10
            
                        End If
                        
                        'Send to export folder if directory isnt blank
                        If Not IsEmpty(Worksheets("Search Interface").Range("D4").Value) Then
                            
                            FileSystem.CopyFile PathName, Worksheets("Search Interface").Range("D4").Value & "\" & FolderName & "\" & "Row Result - " & (PrintRow - 1) & ".docx", True
                                                        
                        End If
                        
                    End With
                    
                PrintRow = PrintRow + 1
                    
                End If
                
                WordDoc.Close SaveChanges:=False
                Set WordDoc = Nothing
                
        End Select
        
        End If
        
ContinueLoop:


    Next
    
Exit Sub


ErrorHandler:


        With Worksheets("Results")
                        
            .Range("A" & PrintRow).Value = File.Name
            
            If IsEmpty(.Range("B" & PrintRow).Value) Then
                .Range("B" & PrintRow).Value = "File triggered error -" & Err.Number & " " & Err.Description & " - VBA Line:" & Erl
                ErrorCount = ErrorCount + 1 'I want to only count errors if the matching process was not able to go through
            End If
            
            .Hyperlinks.Add Anchor:=.Range("C" & PrintRow), Address:=PathName, TextToDisplay:="Link - Click Here"
            
        End With
        
        PrintRow = PrintRow + 1
        
        If Not WordDoc Is Nothing Then
            WordDoc.Close SaveChanges:=False
        End If
        
        Set WordDoc = Nothing
        
Resume ContinueLoop


End Sub
```


----------



## HackSlash (Jan 13, 2017)

Those files that begin with tilde "~" are temporary files created by Word while editing a file. They will be created and destroyed while your program is running. You can't open them and it will cause an error. You need to validate that all the files you are opening are actually word files before you open them. 

Looks like you have an error handler that should identify all the problems you run across.


----------



## bradyboyy88 (Jan 13, 2017)

Yea hackslash the if statement of excluding trying to open those seemed to fix that 5792 error but now I am on to a stranger error type 13 mismatch error that only happens after hundreds of records are opened and closed and just continues into the future for the next 1000 records. Its also not consistent because the amount of successful opens changes every run despite the files are staying the same. 

Say i run one of the subfolders by itself as the hostfolder then it will complete those 100 files fine. Now say I do the parent folder that has hundreds of other files too. Well when it gets to that one folder I just ran it might hit that mismatch error for those files unlike before since its not running 1000s of files. It makes no sense since the process is remaining the same.


here is better commenting of the code:

I put in a line number 10 for the one subroutine and that is where my error handler erl function returns. I have spent so much time trying to figure it out I would have been better going through all 8000 files by hand haha.

Here we go:


```
Option Explicit
Public Word As Variant
Public WordsToFind As New Collection
Public WordsFound As New Collection
Public PrintRow As Integer
Public SubFolderCount As Integer
Public FileCount As Integer
Public FileSystem As Object
Public FolderName As String
Public WordApp As Object
Public WordDoc As Object
Public strDate As String
Public ErrorCount As Integer


Sub Search()
    
    Dim HostFolder As String
    Dim WordsFound(1 To 7)
    Dim SearchWord As Integer
    
    'Clear any collection in memory
    Set WordsToFind = Nothing
    Set FileSystem = Nothing
    Set WordApp = Nothing
    Set WordDoc = Nothing
    
    'Create a new Word object and isntance
    Set WordApp = CreateObject("Word.Application")
    WordApp.Visible = False
    WordApp.DisplayAlerts = False
    
    'In case rerun clear public variable
    FileCount = 0
    SubFolderCount = 0
    ErrorCount = 0
    
    'Clear Current Results Page
    Worksheets("Results").Rows("2:" & Application.Max(Worksheets("Results").UsedRange.Rows.Count, 2)).Delete
    Worksheets("Results").OLEObjects.Delete
    
    'Setting the outputrow for printing results
    PrintRow = 2
    
    'Take sheet values used in program and assign to variables
    With Worksheets("Search Interface")
        
        HostFolder = .Range("D2").Value
        
        'Location of Search Words on Sheet . Code is also dynamic so just increase range if you want to add words
        For SearchWord = 8 To 12
            
            If Not IsEmpty(.Range("C" & SearchWord)) Then
                
                WordsToFind.Add .Range("C" & SearchWord)
            
            End If
            
        Next
        
    End With
    
    'If export spot directory on sheet is not empty then create folder names/variables
    If Not IsEmpty(Worksheets("Search Interface").Range("D4").Value) Then
        
        With Worksheets("Search Interface").Range("D4")
        
            FolderName = "SearchFile-" & Format(Now(), "mmddyyyyhhmmss")
        
            strDate = Format(Now, " dd-mmm-yy h-mm-ss")
            FileNameZip = .Value & "\" & "SearchFileZip " & strDate & ".zip" ' This variable is used in another subroutine made by ron bruin to zip files and is in another module
        
            'Make new Folder for zip
            MkDir .Value & "\" & FolderName
            
        End With
    End If
    
    
    'Run recursive folder search algorithm
    Set FileSystem = CreateObject("Scripting.FileSystemObject")
    RecursiveFolderSearch FileSystem.GetFolder(HostFolder)
  
    'If export spot as stated above is not empty then create the folder which will then be zipped then delete original
    If Not IsEmpty(Worksheets("Search Interface").Range("D4").Value) Then
          
        With Worksheets("Search Interface").Range("D4")
            
            Zip_All_Files_in_Folder .Value & "\" & FolderName, .Value
            FileSystem.deletefolder .Value & "\" & FolderName
            
        End With
    End If
    
    'Clear Memory leaks just in case
    WordApp.Quit
    Set WordsToFind = Nothing
    Set FileSystem = Nothing
    Set WordApp = Nothing
    Set WordDoc = Nothing
    
End Sub


Sub RecursiveFolderSearch(Folder)
    
    Dim SubFolder As Object
    Dim File As Object
    Dim PathName As String
    
    For Each SubFolder In Folder.SubFolders
          
        'This if then will help avoid shortcuts based on my research
        If Folder.Attributes <> 64 Then
            SubFolderCount = SubFolderCount + 1
            RecursiveFolderSearch SubFolder
        End If
    Next
    
    For Each File In Folder.Files
    
    'This is to get around MS stupid 255 character string limit
    If Len(File.Path) > 255 Then
    
        PathName = GetShortFileName(File.Path)
    
    Else
    
        PathName = File.Path
    
    End If
    
    'Just some summary statistics about how many folders and files were actually reviewed in total
    With Worksheets("Results")
        .Range("E1").Value = "Subfolder Count: " & SubFolderCount
        .Range("F1").Value = "Files Reviewed: " & FileCount
        .Range("G1").Value = "Match Count: " & PrintRow - ErrorCount - 2
        .Range("H1").Value = "Error Count: " & ErrorCount
    End With
    
    On Error GoTo ErrorHandler
        
        'Not sure what is causing this error. Maybe old files saved in memory because I dont see them in folder and they were deleted a while back? Either way need to not try and open files with these beginning two letters
        If Not Left(File.Name, 2) = "~$" Then
        
        FileCount = FileCount + 1

        'just to clear memory of this variable before assigning new one by opening worddoc
        Set WordsFound = Nothing
        
        Select Case LCase(Right(File.Name, 4))
            
            Case Is = "docx", ".doc", "docm", "dotm"  'Check if word document
                
'this line keeps tripping error mismatch around 200 files in and continues to do it. I say this line because erl returns 10 and all things accomplished seem to point to this.
10              Set WordDoc = WordApp.Documents.Open(Filename:=PathName, ReadOnly:=True)
                WordDoc.ActiveWindow.View.ReadingLayout = False
                                       
                'Select all and Check if word exists
                WordApp.Selection.WholeStory
                WordApp.Selection.Find.ClearFormatting
                  
               'loops through all possible search words in the keywords to search for and tries to find them in the word document
                For Each Word In WordsToFind

                    With WordApp.Selection.Find
                        
                        .Text = Word
                        .Forward = True
                        .Wrap = 1
                        .Format = False
                        .MatchCase = False
                        .MatchWholeWord = True
                        .MatchWildcards = False
                        .MatchSoundsLike = False
                        .MatchAllWordForms = False
                        

                        If .Execute Then

                         'Adds the word to the collection of words found which will later be printed on sheet  
                            WordsFound.Add Word
                            
                        End If
                        
                    End With
                    
                Next
                
                'if we have atleast one keyword found in the word document then it prints out stuff to excel sheet and transfers to zip folder if that directory was set in the sheet
                If WordsFound.Count > 0 Then
                    
                'outputting the results
                    With Worksheets("Results")
                    
                        .Range("A" & PrintRow).Value = File.Name
                        
                        'This will merge the words found to one cell
                        For Each Word In WordsFound
                            
                            .Range("B" & PrintRow).Value = Word & "/" & .Range("B" & PrintRow).Value
                            
                        Next
                    
                        .Hyperlinks.Add Anchor:=.Range("C" & PrintRow), Address:=PathName, TextToDisplay:="Link - Click Here"
                        
                        'Check if interface wants you to embed file.. Problem is this doesnt seem to allow saving because excel file will always say corrupt and repair but never works so never gets to save
                        If Worksheets("Search Interface").Shapes("EmbedCheckBox").ControlFormat.Value = 1 Then
            
                            .OLEObjects.Add Filename:=PathName, Link:=False, DisplayAsIcon:=True, Left:=.Range("D" & PrintRow).Left + 30, Top:=.Range("D" & PrintRow).Top + 3, Width:=50, Height:=10
            
                        End If
                        
                        'Send to export folder if directory isnt blank
                        If Not IsEmpty(Worksheets("Search Interface").Range("D4").Value) Then
                            
                            FileSystem.CopyFile PathName, Worksheets("Search Interface").Range("D4").Value & "\" & FolderName & "\" & "Row Result - " & (PrintRow - 1) & ".docx", True
                                                        
                        End If
                        
                    End With
                    
                PrintRow = PrintRow + 1
                    
                End If
                
                WordDoc.Close SaveChanges:=False
                Set WordDoc = Nothing
                
        End Select
        
        End If
        
ContinueLoop:


    Next
    
Exit Sub


ErrorHandler:

        'since there was an error it prints out the info to tthe excel sheet what file name was and error info where the keyword stuff should have gone . If keyword stuff was filled out and error tripped after that then it wont delete that info and should keep keywords found instead.  

            With Worksheets("Results")
                        
            .Range("A" & PrintRow).Value = File.Name
            
            If IsEmpty(.Range("B" & PrintRow).Value) Then
                .Range("B" & PrintRow).Value = "File triggered error -" & Err.Number & " " & Err.Description & " - VBA Line:" & Erl
                ErrorCount = ErrorCount + 1 'I want to only count errors if the matching process was not able to go through
            End If
            
            .Hyperlinks.Add Anchor:=.Range("C" & PrintRow), Address:=PathName, TextToDisplay:="Link - Click Here"
            
        End With
        
        PrintRow = PrintRow + 1
        
        If Not WordDoc Is Nothing Then
            WordDoc.Close SaveChanges:=False
        End If
        
        Set WordDoc = Nothing

'GO to the next file like nothing ever happened!        
Resume ContinueLoop


End Sub
```


----------



## HackSlash (Jan 13, 2017)

You might be hitting a limitation of VBA error trapping. You might want to limit the error trap to that one line. Then you can deal with other bugs separately. This will ensure that you only are trapping word open errors with this error trap. You should handle other errors in another way.


```
On Error GoTo ErrorHandler
10              Set WordDoc = WordApp.Documents.Open(Filename:=PathName, ReadOnly:=True)
On Error GoTo 0
```

That clears the errorhandler

You should also add this to the end of your error handler, before it returns:


```
err.clear
```


----------



## bradyboyy88 (Jan 13, 2017)

Thats a good point. Now rerunning puts me at mismatch error and points me to 


```
.text=word
```

When I hover over the yellow highlighted debug line of word it shows its value as "Test" which was one of my keywords which is a string so I dont see why that would be a mismatch.


----------



## bradyboyy88 (Jan 10, 2017)

Hi,

I am wondering if there is a way to use the find keyword function in a word document and excel file without actually opening it using vba?


----------



## HackSlash (Jan 13, 2017)

AHA! It's not declared as a string! It's a variant. I was going to tell you to force it to be a string but that won't work with the for...each statement you have. Instead, let's force the type while it is being put in to a string container so that this can never happen.


```
.text=CStr(word)
```

NOTE: If CSTR fails then it will return null. You might have to handle a null exception later.


----------



## bradyboyy88 (Jan 13, 2017)

Hackslash I just ran through 10k files without a single error because you are a debugging genius.


----------



## HackSlash (Jan 13, 2017)

Awww shucks,
Thanks. I hope you learned about error handling in VBA so you can crush bugs in the future! That error handler you have there is super useful. You can use that code all over the place.


----------



## bradyboyy88 (Jan 13, 2017)

Yes this was an awesome learning experience! THanks a lot man I hopefully one day I can return the favor!


----------

