VBA code running perfectly one one PC, not on Others

[szumerspirit]

I have compiled a VB code, borrowing some, adding some. It's intended purpose is to get information about all files in a directory/disk. Originally I used the the msoFileTypeAll, until I read that it did not always pick up .zip's as files vs folders.

I added a new section to pick up zip files in another fashion. On my machine it worked perfectly. Went through all the sub folders, picked up all files, relooped, picked up all .zip files.

Moved it to another machine, suddenly, it picks up all files in main and subfolders of all types except .zip. It DOES pick up the first .zip file in the main folder, but no others, and ignores all .zips in sub-folders.

I compared the machines piece by piece, XP version, Office version, VB version, even the winzip version out of desperation. All the folder securities even. I am at a total loss. If anyone could please help, I would be eternally grateful. This is running on Office XO, thru an Excel Macro (Version 2003 SP2) with VB 6.3. Please excuse all the commenting out (Leftovers from trying to resolve the original problem)

========================
Sub PopulateDirectoryList()
'dimension variables
Dim objFSO As FileSystemObject, objFolder As Folder
Dim objFile As File, strSourceFolder As String, x As Long, i As Long
Dim wbNew As Workbook, wsNew As Worksheet
Dim InputDisc As String, InputMainFolder As String, InputSubFolder As String
Dim fso, fldr, f 'REMOVE


ToggleStuff False 'turn of screenupdating

Set objFSO = New FileSystemObject 'set a new object in memory
Set fso = CreateObject("Scripting.FileSystemObject") ' REMOVE
strSourceFolder = BrowseForFolder 'call up the browse for folder routine
If strSourceFolder = "" Then Exit Sub

'Workbooks.Add 'create a new workbook

Set wbNew = ActiveWorkbook
Set wsNew = wbNew.Sheets(1) 'set the worksheet
wsNew.Activate
'format a header
With wsNew.Range("A1:H1")
.Value = Array("File", "Size", "Modified Date", "Created Date", "Full Path", "Disc Name", _
"Main Folder", "Sub Folder")
.Interior.ColorIndex = 4
.Font.Bold = True
.Font.Size = 8
End With
With wsNew.Range("A2:H60000")
.Font.Size = 8
End With

With Application.FileSearch
.LookIn = strSourceFolder 'look in the folder browsed to
.Filename = "*.*" 'get all files
.SearchSubFolders = True 'search sub directories
.Execute 'run the search

'create InputBox
InputDisc = InputBox("Enter Disc Name: ", "Disc Name", "Disc ")
InputMainFolder = InputBox("Enter Main Folder: ", "Main Folder Name")
InputSubFolder = InputBox("Enter Sub Folder: ", "Sub Folder Name")



'Set objFSO = New FileSystemObject 'set a new object in memory
'strSourceFolder = BrowseForFolder

'Set objFolder = objFSO.GetFolder(strSourceFolder) 'get the folder
'x = 0
'For Each objFile In objFolder.Files
'rngDir.Offset(x, 0) = strSourceFolder
'rngDir.Offset(x, 1) = objFile.Name
'x = x + 1
'Next objFile

'Set objFolder = Nothing
'Set objFile = Nothing
'Set objFSO = Nothing


Set fldr = fso.GetFolder(strSourceFolder)
x = 0 'remove
For Each f In fldr.Files
If Right(f.Name, 4) = ".zip" Then
'MsgBox f.Name
With wsNew.Cells(2, 1) 'populate the next row with the variable data
.Offset(i, 0) = f.Name
.Offset(i, 1) = Format(f.Size, "0,000") & " KB"
.Offset(i, 2) = f.DateLastModified
.Offset(i, 3) = f.DateCreated
.Offset(i, 4) = f.Path
.Offset(i, 5) = InputDisc
.Offset(i, 6) = InputMainFolder
.Offset(i, 7) = InputSubFolder
End With
End If
x = x + 1
Next
Set f = Nothing


For x = 1 To .FoundFiles.Count 'for each file found, by the count (or index)
i = x 'make the variable i = x
If x > 60000 Then 'if there happens to be more than multipls of 60,000 files, then add a new sheet
i = x - 60000 'set i to the right number for row placement below
Set wsNew = wbNew.Sheets.Add(after:=Sheets(wsNew.Index))
With wsNew.Range("A1:H1")
.Value = Array("File", "Parent Folder", "Full Path", "Modified Date", _
"Size")
.Interior.ColorIndex = 4
.Font.Bold = True
.Font.Size = 8
End With
With wsNew.Range("A2:H7")
.Font.Size = 8
End With

End If
On Error GoTo Skip 'in the event of a permissions error

Set objFile = objFSO.GetFile(.FoundFiles(x)) 'set the object to get it's properties
With wsNew.Cells(2, 1) 'populate the next row with the variable data
.Offset(i, 0) = objFile.Name
.Offset(i, 1) = Format(objFile.Size, "0,000") & " KB"
.Offset(i, 2) = objFile.DateLastModified
.Offset(i, 3) = objFile.DateCreated
.Offset(i, 4) = objFile.Path
.Offset(i, 5) = InputDisc
.Offset(i, 6) = InputMainFolder
.Offset(i, 7) = InputSubFolder

End With
' Next objFile
Skip:
'this is in case a Permission denied error comes up or an unforeseen error
'Do nothing, just go to next file
Next x
wsNew.Columns("A:H").AutoFit

End With

'clear the variables
Set objFolder = Nothing
Set objFile = Nothing
Set objFSO = Nothing
Set wsNew = Nothing
Set wbNew = Nothing

ToggleStuff True 'turn events back on
End Sub
Sub ToggleStuff(ByVal x As Boolean)
Application.ScreenUpdating = x
Application.EnableEvents = x
End Sub


Function BrowseForFolder(Optional OpenAt As Variant) As Variant


Dim ShellApp As Object
Set ShellApp = CreateObject("Shell.Application"). _
BrowseForFolder(0, "Please choose a folder", 0, OpenAt)

On Error Resume Next
BrowseForFolder = ShellApp.self.Path
On Error GoTo 0

Set ShellApp = Nothing

Select Case Mid(BrowseForFolder, 2, 1)
Case Is = ":"
If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid
Case Is = "\"
If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid
Case Else
GoTo Invalid
End Select
Exit Function

Invalid:


ToggleStuff True
End Function

 

[SkipVought]

Hi,

What STATEMENT does it burp on?

Skip,

_[red][/red]

 

[szumerspirit]

Thanks for your reply. It actually runs on all other PCs, but instead of filtering through all main/sub-folders and picking up all files, It picks up the .Zip file in the main folder, then loops through all the sub-folders and only picks up all files Except .zip.

On the first PC it loops through all main/sub folders and picks up ALL files both .zip and others (I am using a disk with a large mixture of subfolders containing both .zip files and others for testing.

So it it definitely looping through the Subs to pick up all other file types (PPT, Txt, etc) and it is definitely seeing the first .zip file in the main folder. It is just not picking up the other .zip in the sub. So I am wondering if the other PCs are not recognizing the "Loop" function when it get to the GetFolder portion, altho it recognizes it on mine.

Could some file difference in the PCs system files cause it? The reference's are set the same and in the same priority. I am definitely stumped!

 

[SkipVought]

Did you try a break and stepping thru at appropriate places in the code?

Use the Watch Window to examine variables and obejcts.

Skip,

_[red][/red]

 

[szumerspirit]

I will try that. I hadn't yet, as I have learned most of this by trial and error, not formal education

Thanks for the suggestion

 

[SkipVought]

I believe that you will find that many, here, could say that about some area of expertise. Press on!

Skip,

_[red][/red]

 

[combo]

You could try to clear the search criteria:

With Application.FileSearch
.NewSearch
.LookIn = strSourceFolder
...

combo