PDA

View Full Version : [SOLVED] List all Excel and Word files in a folder containing specific text



vanhunk
10-30-2014, 01:17 AM
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
10-30-2014, 01:31 AM
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
10-30-2014, 04:16 AM
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
10-30-2014, 05:51 AM
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
10-30-2014, 06:01 AM
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
10-30-2014, 06:07 AM
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
10-30-2014, 06:08 AM
you're not using c01 or Path1 in you code.

vanhunk
10-30-2014, 06:25 AM
@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
10-30-2014, 06:37 AM
@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
10-30-2014, 06:45 AM
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
10-30-2014, 06:51 AM
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 (file://\\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
10-30-2014, 07:18 AM
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
10-30-2014, 08:12 AM
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
10-30-2014, 11:57 PM
Thank you snb,
You are too good.
Regards,
vanhunk