PDA

View Full Version : Solved: Working Code not finding server folders



rrenis
08-24-2007, 04:25 AM
Hi all - thanks for looking at this post. I have the following code which up until yesterday was working fine.

It lists the immediate sub folders of a specified server folder without going on to list any further sub-folders (it need to be like this to keep things clean in the userform listbox). When I run the code now only new folders are displayed none of the original folders are returned. No amendments to the code have been made so I'm 100% sure it's not the code failing. I've spoken to our IT dept who say as the folders are visible in Explorer there isn't a problem with the server. I'm sure it's linked to permissions as when the IT dept refreshed the permissions on the folder the few test folders I'd created were no longer found and only new folders from that point are returned by the search.

Since the IT dept are adament there is nothing they can do my question is two fold.

1st - does anyone know what could be causing this so I can take it back to the IT dept to check. (my preferred solution)

2nd - does anyone know an alternative way of acheiving the same thing which doesn't look at attributes, which I guess is the problem because if I use Application.FileSearch to return a list of files (not folders) within a specific folder (which is not returned by the following code) it finds all of the files.

Here's the code which is part of a userform...

Const ARRAY_INITIAL = 1000
Const ARRAY_INCREMENT = 100
Const FILE_ATTRIBUTE_DIRECTORY = &H10
Private Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long
Dim arrFiles() As String
Dim myFolder As String
Dim CurrentSubFolder As String
Private Sub UserForm_Initialize()

CommandButton2_Click

End Sub

Private Sub CommandButton2_Click()

Dim X As Integer

myFolder = "P:\General Filing\My Files\"

ListBox1.Clear
ListBox1.Visible = False

Call spanFoldersStart(myFolder, "*.*")

For X = 0 To UBound(arrFiles)
If arrFiles(X) = myFolder Then GoTo NEXTX Else
ListBox1.AddItem Mid(arrFiles(X), InStr(arrFiles(X), myFolder) + Len(myFolder))
NEXTX:
Next X
ListBox1.Visible = True
ListBox4.AddItem myFolder

End Sub

Public Function spanFoldersStart(startfolder As String, srchstr As String)

Dim sFileName As String
Dim sfoldername As String
Dim idx As Integer
Dim limit As Integer

ReDim arrFiles(ARRAY_INITIAL)
On Error GoTo errHandle

idx = 0
arrFiles(0) = startfolder
limit = 1
Do While idx < limit
sfoldername = arrFiles(idx)
sFileName = Dir(sfoldername & srchstr, vbDirectory)
Do While (sFileName <> "") And (DirLevel(sfoldername) < 4)

If GetFileAttributes(sfoldername & sFileName) = _
FILE_ATTRIBUTE_DIRECTORY Then
If sFileName <> "." And sFileName <> ".." Then
arrFiles(limit) = sfoldername & sFileName & "\"
limit = limit + 1
End If

End If
sFileName = Dir
Loop
idx = idx + 1
Loop

ReDim Preserve arrFiles(limit - 1)

Exit Function

errHandle:
If Err.Number = 9 Then
ReDim Preserve arrFiles(UBound(arrFiles) + ARRAY_INCREMENT)
Resume
Else
Err.Raise Err.Number, Err.Source, Err.Description
End If

End Function
Public Function DirLevel(fldr As String) As Long

Dim i As Long, result As Long
result = 0
For i = 1 To Len(fldr)
If Mid(fldr, i, 1) = "\" Then result = result + 1
Next
DirLevel = result
End Function


If I change myFolder to C:\Windows\System32\ (I have Admin rights on my PC - this doesn't work on a laptop where I don't have admin rights - which again leads me to think it's a permissions issue?) it works fine.

I have full control in the permissions of the Server folder so on the face of it everything looks OK, but it's not working :think:

Any help would be great! : pray2:

Cheers,
rrenis

Bob Phillips
08-24-2007, 04:51 AM
Don't have the answer, but have you tried GetAttr, a VBA Function, rather than the GetFileAttributes API?

rrenis
08-24-2007, 05:01 AM
hi xld :hi:

thanks - I hadn't tried that, but I've just substituted GetFileAttributes with GetAttr as shown below (I assume there's nothing more to it than that?) and it returned the same results. :(

If GetFileAttributes(sfoldername & sFileName) = _
FILE_ATTRIBUTE_DIRECTORY Then

If GetAttr(sfoldername & sFileName) = _
FILE_ATTRIBUTE_DIRECTORY Then

Cheers,
rrenis.

rrenis
08-24-2007, 05:16 AM
Just been looking at what's changed on my PC since the last time this code worked. It seems a load of security updates were applied via our IT dept's remote update on shut down. Trouble is they're for the wrong version of office. Just removing them now.... fingers crossed! :dau:

Cheers,
rennis

rrenis
08-24-2007, 05:46 AM
Unfortunately that's not the problem so it's still not solved (despite me marking it as solved)... :(

Cheers,
rrenis.