CheckFiles

[kreshnr]

Hi All,
I am using below mentioned Code for checking if certain file exist on Path.
Its working on my home PC (XP SP2 Excel 2003).
BUT its not working on my office PC (XP SP2 Excel 2003).

Can somebody tell me why its not working in my office PC ( or if its missing something, then from where can i download it.)

Sub CheckFiles()
Const strFolder = "C:\Documents and Settings\kreshnr\Desktop\Test"
Dim fso, msg, i
Dim rngData As Range

Set fso = CreateObject("Scripting.FileSystemObject")
Set rngData = Sheets("Sheet1").Range("A1")

With rngData
Do While .Offset(i, 0).Value <> ""
If (fso.FileExists(strFolder & .Offset(i, 0).Value & ". ")) Then
.Offset(i, 2).Value = "Yes"
Else
.Offset(i, 2).Value = "No"
End If
i = i + 1
Loop
End With
End Sub

Regards

Kreshnr

 

[kreshnr]

Range A1:A5 file names x,y,z and folder names a,b

on Path "D:\Test\" two files are exist there x and y with one folder exist named a.

So the Result on Offset range B1:B5 Should be "Yes","Yes" and "No" for files x,y and z with "Yes" and "No" for folders a and b.

i tried to below mentioned code which doesn't work for now , it just gives "yes" for all irrespective they exist on the given path or not.

Sub CheckFilesandfolders()
Const strFolder = "D:\Test\"
Dim msg, i
Dim rngData As Range

Set rngData = Sheets("Sheet1").Range("A1")

With rngData
Do While .Offset(i, 0).Value <> ""
If Dir(strFolder, vbDirectory) <> "" Then
.Offset(i, 1).Value = "Yes"
Else
.Offset(i, 1).Value = "No"
End If
i = i + 1
Loop
End With
End Sub

Regards

Kreshnr

 

[Kenneth Hobson]

Your code is looping the number of cells from A1 to the first empty cell. However, you are not appending anything to the strFolder so it just keeps checking that folder.

Are the values in column A, subfolders of strFolder. If so, then use:

 If Dir(strFolder & "\" & .Offset(i, 0).Value, vbDirectory) <> "" Then

 

[kreshnr]

Sub CheckFilesandfolders()
Const strFolder = "D:\Test\"
Dim msg, i
Dim rngData As Range

Set rngData = Sheets("Sheet1").Range("A1")

With rngData
Do While .Offset(i, 0).Value <> ""
If Dir(strFolder & "\" & .Offset(i, 0).Value, vbDirectory) <> "" Then
.Offset(i, 1).Value = "Yes"
Else
.Offset(i, 1).Value = "No"
End If
i = i + 1
Loop
End With
End Sub

This code works fine with when strFolder = "D:\Test\" with all the folders and files are inside "D:\Test\",

BUT With folder b inside folder a which means "D:\Test\a\b" and with files x and y inside the folder b its not yielding results. although the folders which are directly inside "D:\Test"
like folder a and files its returning the result correctly.

 

[Kenneth Hobson]

Are you mixing filenames and subfolder names in the values of column A cells?

 

[kreshnr]

1. Path "D:\Test\" contains folder named a and files x and y.

2. Path "D:\Test\a\" contains folder b and file z.

Range A1:A5 Contains values x,y,z,a and b.

and in my code

Const strFolder = "D:\Test\" is given

its yielding right results "yes" on offset column for point 1. folder and files but returning with wrong result "no" on offset column for point 2.

 

[Joe Was]

I wrote you a custom sheet function, to test for files.

You store it in a standard code module like "Module1" and then you can run it just like any sheet function in Excel.

The syntax and HELP are in the custom User Defined Function (UDF):

Private Function IsFileTrue(fDriveFolder, fName, fExtension) As Boolean
'Standard module code function, like: Module1.

'Syntax: as strings or cell locations
'=IsFileTrue("C:\cp\",A2,".txt")
'Note: If using values in cells, do not use quotes in cells!

'If file is found: Returns TRUE, else FALSE.
Dim strFolderFile$, strTestWhat$

strTestWhat = fDriveFolder & fName & fExtension
strFolderFile = Dir(strTestWhat)

'To activate help input: FileExists(,"Help",)
If UCase(fName) = "HELP" Then
MsgBox " Syntax: =IsFileTrue(DriveFolder,FileName,Extention)" & vbCr & vbCr & _
"Like ==> =IsFileTrue(""C:\cp\"",A2,"".txt"")"
End If

If strFolderFile <> "" Then
IsFileTrue = True
Else

IsFileTrue = False
End If
End Function

 

[kreshnr]

Thanx Jim,

Thanx for the solution but it is giving me "false" result.

Dose this has to do with some scripts. as i think in my machine i don have rights to run wscripts.

Regards

Kreshnr

 

[Joe Was]

This code will ask you for a parent folder, using a selection Dialog [no typing!] then it will list all the Sub-Folders for that selection!
Note: I have it dumping to a MsgBox so it is limited to a display of about 30 or so sub-folders, yet it will count all of them!
You can add code to dump the info to a sheet if you need to.

Public myLst$, myCnt&

Sub sSubFolders()
'Standard module code, like: Module1.
Dim myFSO As Object, fso As Object

myList = ""
myCnt = 0

Set myFSO = CreateObject("Shell.Application"). _
BrowseForFolder(0, "Please Select Folder", 0, Left(CurDir, 3))

Set fso = CreateObject("Scripting.FileSystemObject")

ShowSubFolders fso.GetFolder(myFSO.Items.Item.Path & "\")

Set myFSO = Nothing

MsgBox myCnt & Space(3) & "folders found:" & vbLf & vbLf & _
myLst

myLst = xlNull
End Sub

Private Sub ShowSubFolders(ByVal Folder As Variant)
'Standard module code, like: Module1.
Dim subFolder As Object

For Each subFolder In Folder.SubFolders
myCnt = myCnt + 1
myLst = myLst & vbLf & myCnt & ": " & subFolder.Path

ShowSubFolders subFolder
Next subFolder
End Sub

 

[Joe Was]

THis will dump all the file info for each file in a folder to a sheet:

Sub List_Files()
'Standard module code, like: Module1.
Dim fsoObj As Object, fsoMapp As Object, MySubFolder As Object, fsoFil As Object
Dim sFolder As String
Dim lngFoundFileIndex As Long
Dim filtype As String

sFolder = "C:\Users\xxx\My Files\JSW\Excel\Test\FromWork"

Set fsoObj = CreateObject("Scripting.FileSystemObject")
Set fsoMapp = fsoObj.GetFolder(sFolder)
Set fsoFil = CreateObject("Scripting.FileSystemObject")

With Range("A5:H5")
.Value = Array("Filename", "Created", "Last changed", "Size", "Type", "Drive", "Folder", "Path")
.Font.Bold = True
End With

lngFoundFileIndex = 4

If Not fsoMapp Is Nothing Then
For Each MySubFolder In fsoMapp.SubFolders
For Each fsoFil In MySubFolder.Files
'If (fsoFil.Name Like "*.*" And fsoFil.DateLastModified = Date) Then

lngFoundFileIndex = lngFoundFileIndex + 1

With fsoFil
Cells(1 + lngFoundFileIndex, 1).Value = .Name
Cells(1 + lngFoundFileIndex, 2).Value = .DateCreated
Cells(1 + lngFoundFileIndex, 3).Value = .DateLastModified
Cells(1 + lngFoundFileIndex, 4).Value = .Size
Cells(1 + lngFoundFileIndex, 5).Value = .Type
Cells(1 + lngFoundFileIndex, 6).Value = .Drive
Cells(1 + lngFoundFileIndex, 7).Value = .ParentFolder
Cells(1 + lngFoundFileIndex, 8).Value = .Path
End With
'End If
Next fsoFil
Next MySubFolder
End If

Columns("A:H").EntireColumn.AutoFit

Set fsoFil = Nothing
Set fsoMapp = Nothing
Set fsoObj = Nothing
End Sub

 

[Kenneth Hobson]

It would be best if you posted the data that you are passing to the function. Filenames must have a file extension so filenames like x and y make no sense.

You can post a sample xls to a free shared site like 4shared.com.

If you can't use the file scripting object, then another method is needed if you are trying to search subfolders.

Your work's Administrator may have disabled FSO or not have installed it. If so, antoher method would be needed. However, without knowing just what you are checking, it is not worth guessing at a solution.

e.g.

1. Check that files in column A1 and down exist.
a1="c:\test.xls"
a2="c:\Excel\test.xls"

2. Check that files in column A1 and down exist with a base folder name.
basename="c:\Documents and Settings\Kenneth Hobson\My Documents\"
a1="test.xls"
a2="Excel\test.xls"

3. Like (2) but file extension is always ".xls"
a1="test"
a2="Excel\test"

4. Check that subfolders of base folder exists.
basename="c:\Documents and Settings\Kenneth Hobson\My Documents\"
a1="Excel"
a2="PowerPoint"
a3="MSWord"
a4="MSWord\Customers"