Consulting

Page 2 of 2 FirstFirst 1 2
Results 21 to 28 of 28

Thread: search a column of keywords in a folder of .docs and match file names and string

  1. #21
    VBAX Regular
    Joined
    Dec 2017
    Posts
    21
    Location
    Quote Originally Posted by Kenneth Hobs View Post
    snb's example was to show how findstr can help. Change MsgBox.Exec to MsgBox .Exec in post #21.

    I can not duplicate your system restore issue. When a macro "hangs" and ESC key presses or Break key does not abort it, the 3 finger solute (Alt+Ctrl+Del, Task Manager, Kill) is the usual method to Kill the Excel instance. It is always best to run a macro like mine by itself with no other Excel files open. That is, at least until you know what to expect.

    I can not duplicate your timing problem for those files. I did say it took a "long time" to run. My run with your files took about 44 seconds. Anything over 5 seconds is a long time to me. I like to see under one second but you wanted to get the character count / 65 for each match.

    snb or I could show you how to modify his code to do what mine does, less the character count / 65.

    I added an ESC key option. When you abort a macro like mine, it can leave an instance of Word that needs to be Killed via 3 finger solute before another run or you could get an OLE error.
    Thank you very much for your time, effort, and commitment.

    [CODE] a = aFFs(p & "*.doc", , True) [CODE]

    I am getting a compile error for the above portion prompting "sub or function not defined" for "aFFs"

  2. #22
    VBAX Regular
    Joined
    Dec 2017
    Posts
    21
    Location
    Quote Originally Posted by snb View Post
    @KH

    Sub M_snb() 
      sn = ThisWorkbook.Sheets(1).Columns(1).SpecialCells(2) 
         
      With CreateObject("wscript.shell") 
        For j = 2 To UBound(sn) 
           c00=c00 & vbcrlf & .Exec("cmd /c findstr /m/s SD/#" & Format(sn(j, 1), "0000") & "/ G:\test_snb\mainfolder\*.doc").StdOut.ReadAll
        Next 
      End With 
      with createobject("scripting.filesystemobject")
         st=split(c00,vbcrlf)
         for j=1 to ubound(st)
            
         next
      end with
    End Sub
    thank you, I have tried but nothing happens with it. My excel version is office 2007

  3. #23
    VBAX Guru Kenneth Hobs's Avatar
    Joined
    Nov 2005
    Location
    Tecumseh, OK
    Posts
    4,956
    Location
    aFFs() and the following Sub in it was already shown in previous posts.

  4. #24
    VBAX Regular
    Joined
    Dec 2017
    Posts
    21
    Location
    Quote Originally Posted by Kenneth Hobs View Post
    aFFs() and the following Sub in it was already shown in previous posts.
    Thank you... I will just check my pc and see if office can be reinstalled and then will try it...

  5. #25
    VBAX Guru Kenneth Hobs's Avatar
    Joined
    Nov 2005
    Location
    Tecumseh, OK
    Posts
    4,956
    Location
    Combining what I did with snb's findstr method, less the characters/65 it ran in 1.4 seconds. We could use GetDetailsOf() to get the word count quickly if that would help any.

    snb does not use Option Explicit so Dim is not needed. Obviously, change the value of ws and p to suit.

    You can delete the two lines with Timer if you don't want that. Debug.Print puts the result into the Immediate Window (Ctrl+G) after a run.
    Sub snbkh()  
      d = Timer
      Set ws = ThisWorkbook.Sheets(1)
      p = "C:\Users\lenovo1\Dropbox\Excel\Word\MainFolder\"
      
      On Error GoTo EndSub
      Application.EnableCancelKey = xlErrorHandler
      
      Set fso = CreateObject("Scripting.FileSystemObject")
      ReDim b(1 To Rows.Count, 1 To 3)
      
      sn = ws.Columns(1).SpecialCells(2)
      With CreateObject("WScript.Shell")
        For Z = 2 To UBound(sn)
          s = .Exec("cmd /c findstr /m/s SD/#" & Format(sn(Z, 1), "0000") & "/ " & _
            """" & p & "*.doc" & """").StdOut.ReadAll
          If Len(s) <> 0 Then
            s = Left(s, Len(s) - 2) 'Trim trailing vbCrLF
            a = Split(s, vbCrLf)
            For i = 0 To UBound(a)
              j = j + 1
              b(j, 1) = fso.GetFile(a(i)).Name
              b(j, 2) = sn(Z, 1)
              fn = fso.GetParentFolderName(a(i))
              If Len(fn) > Len(p) Then b(j, 3) = Right(fn, Len(fn) - Len(p))
            Next i
          End If
        Next Z
      End With
      
      If j = 0 Then GoTo EndSub
       
      b = Application.Index(b, Evaluate("row(1:" & j & ")"), Application.Transpose([row(1:3)]))
      ws.[B2].Resize(j, 3).Value = b
      ws.UsedRange.Columns.AutoFit
         
    EndSub:
      Set fso = Nothing
      Application.DisplayAlerts = True
      Application.EnableCancelKey = xlInterrupt
      Debug.Print Timer - d
    End Sub

  6. #26
    Knowledge Base Approver VBAX Wizard
    Joined
    Apr 2012
    Posts
    5,635
    Quote Originally Posted by sibjac View Post
    thank you, I have tried but nothing happens with it. My excel version is office 2007
    Did you ever program something in VBA ?

  7. #27
    VBAX Regular
    Joined
    Dec 2017
    Posts
    21
    Location
    [/QUOTE]

    sorry for being late to reply. I have tried the the macro in folder MainFolder, but the macro did not print anything, just a blank excel.

  8. #28
    VBAX Regular
    Joined
    Dec 2017
    Posts
    21
    Location
    Hats off to Hobs and snb, it worked when I reinstalled my office, solved a big headache. Thanks a lot.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •