List all Excel and Word files in a folder containing specific text

[vanhunk]

List all Excel and Word files in a folder containing specific text, do not list any other format containing the specified text:
I want to list all the Excel and Word files in a folder containing the text “KPITD”, and only the Excel and Word files, no other formats.

The following code does one or the other, how can it be changed to achieve the desired result in on go?:

Sub IterateAndHyperlinkFiles()
      Dim ctr As Integer
      Dim Path As String
      Dim File As String
      
      ctr = 1
    
     'I want a list of all the files, Excel and Word only, that contain “KPITD” in their names:
     'The following line, when used, lists all the Excel files:
      Path = \\mgadmdat\public\Process Safety\Work in Progress\KPIs\KPI Tools\Toets Folder\*KPITD*.xls?
     
     'The following line, when used, lists all the Word files:
      Path = "\\mgadmdat\public\Process Safety\Work in Progress\KPIs\KPI Tools\Toets Folder\*KPITD*.doc?"
     
     'Can it somehow be combined to achieve the desired result?
       
      File = Dir(Path)    ' Retrieving the first entry.
      
      Do Until File = ""   ' Start the loop.
          
         ActiveSheet.Cells(ctr, 1).Hyperlinks.Add anchor:=ActiveSheet.Cells(ctr, 1), _
              Address:=Path & File, TextToDisplay:=File
        
         ctr = ctr + 1
        
         File = Dir()   ' Getting next entry.
      
      Loop
      

      End Sub

Thank you very much,
vanhunk

[snb]

Sub M_snb()
    c00 = "\\mgadmdat\public\Process Safety\Work in Progress\KPIs\KPI Tools\Toets Folder\*KPITD*.*"
    
    sn = Split(CreateObject("wscript.shell").exec("cmd /c Dir """ & c00 & """ /b/a").stdout.readall, vbCrLf)
    c01 = Join(Filter(sn, ".doc"), vbCrLf) & vbCrLf & Join(Filter(sn, ".doc"), vbCrLf)
End Sub

[vanhunk]

Thank you snb,

It is working great.

Regards,
vanhunk

The code below incorporated your reply and is achieving the desired outcome:

Sub IterateAndHyperlinkFiles()
    Dim ctr As Integer
    Dim Path0 As String
    Dim Path1 As String
    Dim File As String
    Dim sn As Variant
    
    ctr = 1
    
    Path0 = "\\mgadmdat\public\Process Safety\Work in Progress - Henk's Folder\KPIs\KPI Tools\Toets Folder\*KPITD*.*"
    
    sn = Split(CreateObject("wscript.shell").exec("cmd /c Dir """ & Path0 & """ /b/a").stdout.readall, vbCrLf)
    
    Path1 = Join(Filter(sn, ".doc"), vbCrLf) & vbCrLf & Join(Filter(sn, ".doc"), vbCrLf)
        
    File = Dir(Path0)    ' Retrieving the first entry.
    
    Do Until File = ""   ' Start the loop.
        
       ActiveSheet.Cells(ctr, 1).Hyperlinks.Add anchor:=ActiveSheet.Cells(ctr, 1), _
            Address:=Path1 & File, TextToDisplay:=File
      
       ctr = ctr + 1
      
       File = Dir()   ' Getting next entry.
    
    Loop
    
    End Sub

[vanhunk]

Thank you snb,

Sorry, it is not working as it is supposed to.

Regards,
vanhunk

The code below incorporated your reply but is not achieving the desired outcome, it also list other files, such as pdf that contains "KPITD":

Sub IterateAndHyperlinkFiles()
    Dim ctr As Integer
    Dim Path0 As String
    Dim Path1 As String
    Dim File As String
    Dim sn As Variant
    
    ctr = 1
    
    Path0 = "\\mgadmdat\public\Process Safety\Work in Progress - Henk's Folder\KPIs\KPI Tools\Toets Folder\*KPITD*.*"
    
    sn = Split(CreateObject("wscript.shell").exec("cmd /c Dir """ & Path0 & """ /b/a").stdout.readall, vbCrLf)
    
    Path1 = Join(Filter(sn, ".doc"), vbCrLf) & vbCrLf & Join(Filter(sn, ".doc"), vbCrLf)
        
    File = Dir(Path0)    ' Retrieving the first entry.
    
    Do Until File = ""   ' Start the loop.
        
       ActiveSheet.Cells(ctr, 1).Hyperlinks.Add anchor:=ActiveSheet.Cells(ctr, 1), _
            Address:=Path1 & File, TextToDisplay:=File
      
       ctr = ctr + 1
      
       File = Dir()   ' Getting next entry.
    
    Loop
    
    End Sub

[ashleyuk1984]

I presume this is the cause. It's just a small typo.

Path1 = Join(Filter(sn, ".doc"), vbCrLf) & vbCrLf & Join(Filter(sn, ".doc"), vbCrLf)

Replace it with this

Path1 = Join(Filter(sn, ".doc"), vbCrLf) & vbCrLf & Join(Filter(sn, ".xls"), vbCrLf)

[snb]

I wouldn't mind to receive more detailed feedback.

Sub M_snb() 
    c00 = "\\mgadmdat\public\Process Safety\Work in Progress\KPIs\KPI Tools\Toets Folder\*KPITD*.*" 
     
    sn = Split(CreateObject("wscript.shell").exec("cmd /c Dir """ & c00 & """ /b/a").stdout.readall, vbCrLf) 
    c01 = Join(Filter(sn, ".doc"), vbCrLf) & vbCrLf & Join(Filter(sn, ".xls"), vbCrLf) 
End Sub

[mancubus]

you're not using c01 or Path1 in you code.

[vanhunk]

@snb & mancubus:
Clearly I am completely lost here.

snb, your code creates an array with the list of all the files containing the relevant text (i.e. "KPITD"), but then nothing further happens. The files are not listed anywhere. It could be that they are flashed on the screen, but that happens so fast I can't see a thing. In my original code the file names are listed on the sheet as hyperlinks to the files itself.

How do I get the result of c01 listed on the sheet?

Regards,
vanhunk

[vanhunk]

@snb:
I have included a message box to show c01 and it contains the desired list. I guess something like split(c01,vbCrLf) could be used to break up c01 into cells. Please show me how to get the result of c01 listed on the sheet.

Regards,
vanhunk

[mancubus]

perhaps:

Sub M_snb()
    c00 = "\\mgadmdat\public\Process"]\\mgadmdat\public\Process Safety\Work in Progress\KPIs\KPI Tools\Toets Folder\*KPITD*.*"
    Path1 = "\\mgadmdat\public\Process"]\\mgadmdat\public\Process Safety\Work in Progress\KPIs\KPI Tools\Toets Folder\"
    
    sn = Split(CreateObject("wscript.shell").exec("cmd /c Dir """ & c00 & """ /b/a").stdout.readall, vbCrLf)
    c01 = Join(Filter(sn, ".doc"), vbCrLf) & Join(Filter(sn, ".xls"), vbCrLf)
    c01 = Split(c01, vbCrLf)
    'or
    'c01 = Split(Join(Filter(sn, ".doc"), vbCrLf) & Join(Filter(sn, ".xls"), vbCrLf), vbCrLf)
    
    With ActiveSheet
        .Cells.Clear
        .Cells(1).Resize(UBound(c01) + 1) = Application.Transpose(c01)
        For i = 1 To UBound(c01) + 1
            .Hyperlinks.Add Anchor:=.Cells(i, 1), Address:=Path1 & .Cells(i, 1).Value, TextToDisplay:=.Cells(i, 1).Value
        Next
    End With
End Sub

[JKwan]

or this

Sub IterateAndHyperlinkFiles()
    Dim ctr As Integer
    Dim Path0 As String
    Dim Path1 As String
    Dim File As String
    Dim sn As Variant
    Dim FileNames As Variant
    ctr = 1
    
    Path0 = "\\mgadmdat\public\Process Safety\Work in Progress - Henk's Folder\KPIs\KPI Tools\Toets Folder\*KPITD*.*"
    'Path0 = "c:\temp\"
    
    sn = Split(CreateObject("wscript.shell").exec("cmd /c Dir """ & Path0 & """ /b/a").stdout.readall, vbCrLf)
    
    Path1 = Join(Filter(sn, ".xls"), vbCrLf) & vbCrLf & Join(Filter(sn, ".doc"), vbCrLf)
    FileNames = Split(Path1, vbCrLf)
    For Index = 0 To UBound(FileNames)
        ActiveSheet.Cells(ctr, 1).Hyperlinks.Add anchor:=ActiveSheet.Cells(ctr, 1), _
        Address:=Path0 & FileNames(Index), TextToDisplay:=FileNames(Index)
        
        ctr = ctr + 1
        
    Next Index
End Sub

[vanhunk]

Success!!

Thank you snb, mancubus and JKwan.

Regards,
vanhunk

Sub ListWordExcelKPITD()
Dim c00 As String
Dim sn As Variant
Dim c01 As String
Dim List As Variant
Dim i As Integer
Dim Path As String

    Path = "\\mgadmdat\public\Process Safety\Work in Progress\KPIs\KPI Tools\Toets Folder\"

    c00 = "\\mgadmdat\public\Process Safety\Work in Progress\KPIs\KPI Tools\Toets Folder\*KPITD*.*"
     
    sn = Split(CreateObject("wscript.shell").exec("cmd /c Dir """ & c00 & """ /b/a").stdout.readall, vbCrLf)
    
    c01 = Join(Filter(sn, ".doc"), vbCrLf) & vbCrLf & Join(Filter(sn, ".xls"), vbCrLf)
    
    MsgBox c01
    
    List = Split(c01, vbCrLf)
    
    For i = 0 To UBound(List)
         ActiveSheet.Cells(i + 1, 1).Hyperlinks.Add Anchor:=ActiveSheet.Cells(i + 1, 1), _
                Address:=Path & List(i), TextToDisplay:=List(i)
    Next i
    
End Sub

[snb]

or

Sub ListWordExcelKPITD() 
    c00 = "\\mgadmdat\public\Process Safety\Work in Progress\KPIs\KPI Tools\Toets Folder\*KPITD*.*" 
     
    sn = Split(CreateObject("wscript.shell").exec("cmd /c Dir """ & c00 & """ /b/a/s").stdout.readall, vbCrLf) 
    sn = split(Join(Filter(sn, ".doc"), vbCrLf) & vbCrLf & Join(Filter(sn, ".xls"), vbCrLf),vbcrlf)

    For j= 0 To UBound(sn) 
        ActiveSheet.Hyperlinks.Add ActiveSheet.Cells(j + 1, 1),sn(j), , ,dir(sn(j)) 
    Next
End Sub

[vanhunk]

Thank you snb,
You are too good.
Regards,
vanhunk