Edit message of a file search to a Cell
 

Hi,

I try to establish if certain file names are present on a
certain location and if they are I would like this to be
entered in the next column.

What I have so far to identify if a file exist is a bit
of a workaround.

Sub Start()
Dim rngStartPoint As Range
Range("A1").Activate
Set rngStartPoint = ActiveCell
Do
If ActiveCell.Offset(1, 1) = "" Then
Exit Do
ElseIf ActiveCell.Offset(1, 0) < "" Then
Else
Call File_Search
End If
ActiveCell.Offset(1, 0).Activate
Loop
rngStartPoint.Activate
End Sub

Sub File_Search()
Set fs = Application.FileSearch
With fs
.NewSearch
.LookIn = "X:\"
.SearchSubFolders = True
.Filename = ActiveCell
If .Execute() 0 Then
MsgBox "There were " & .FoundFiles.Count & _
" file(s) found."
For i = 1 To .FoundFiles.Count
MsgBox .FoundFiles(i)
Next i
Else
MsgBox "There were no files found."
End If
End With

End Sub

it only works with spacings between all the cells and the
column to the right needs to be filled (changing this
would also be nice).

Requested ouptut:
'Name 'Result
File1a.xxx Y
File1b.xxx N

Thanks in advance,
Hans Weustink

Edit message of a file search to a Cell
 

Assume you have a list of file names in Column A starting in A2 and you want
to put a Y in column B of that row for those files found in the directory
C:\Myfolder or a "N" if not found.

Sub Start()
Range("A2").Activate
chDrive "C"
chDir "C:\MyFolder"
Do
if ActiveCell.offset(0,1) = "" then
if Dir(ActiveCell.Value) < "" then
ActiveCell.Offset(0,1) = "Y"
else
ActiveCell.Offset(0,1) = "N"
end if
End if
ActiveCell.offset(1,0).Select
Loop while ActiveCell.Value < ""
Range("A1").Select
End Sub

--
Regards,
Tom Ogilvy





"Hans Weustink" wrote in message
...
Hi,

I try to establish if certain file names are present on a
certain location and if they are I would like this to be
entered in the next column.

What I have so far to identify if a file exist is a bit
of a workaround.

Sub Start()
Dim rngStartPoint As Range
Range("A1").Activate
Set rngStartPoint = ActiveCell
Do
If ActiveCell.Offset(1, 1) = "" Then
Exit Do
ElseIf ActiveCell.Offset(1, 0) < "" Then
Else
Call File_Search
End If
ActiveCell.Offset(1, 0).Activate
Loop
rngStartPoint.Activate
End Sub

Sub File_Search()
Set fs = Application.FileSearch
With fs
.NewSearch
.LookIn = "X:\"
.SearchSubFolders = True
.Filename = ActiveCell
If .Execute() 0 Then
MsgBox "There were " & .FoundFiles.Count & _
" file(s) found."
For i = 1 To .FoundFiles.Count
MsgBox .FoundFiles(i)
Next i
Else
MsgBox "There were no files found."
End If
End With

End Sub

it only works with spacings between all the cells and the
column to the right needs to be filled (changing this
would also be nice).

Requested ouptut:
'Name 'Result
File1a.xxx Y
File1b.xxx N

Thanks in advance,
Hans Weustink