Alan,
Some reason the server won't let me post on this subject, from OE, so
I'm trying from Googlr groups..
A couple of points:
- Unless you are using it somewhere not shown in this routine,
arrHeaders()
serves no purpose. Also, you are creating 41 elements, but only using
40 (0
to 39).
- There's no need to .Select the cell. This will slow down code. Just
increment the Offset.
- In you second loop, check if the item is a "File Folder" and if so
call
this function recursively to get its details.
http://btmtz.mvps.org/drvscan/
- Regarding you actual problem, "C:\My Documents" is not a real folder;
it
maps to "C:\Documents and Settings\{UserName}\My Documents". If you use
that
folder path it works.
You can use the API SHGetSpecialFolderLocation to get the correct path:
http://www.developerfusion.co.uk/show/251/
Other info available:
http://btmtz.mvps.org/shfileinfo/
However, I saw the same problem between using a constant compared to a
variable of exactly the same value. That does seem very strange as they
are
both the same string. I don't use NameSpace etc much, so some else may
have
a reasonable explanation for this :
'<This works
Const MyPath As String = "C:\Documents and Settings\Nick\My Documents"
Set objFolder = objShell.NameSpace(MyPath )
'</This works
'<This fails
Dim FolderPath As String
Const MyPath As String = "C:\Documents and Settings\Nick\My Documents"
FolderPath =MyPath
Set objFolder = objShell.NameSpace(FolderPath)
'</This fails
However, setting a reference to "MS Shell controls and Automation",
then
declaring the appropriate variables, gave me this code, which seems to
work:
'<Code
Private Declare Function SHGetSpecialFolderLocation Lib "Shell32.dll" _
(ByVal
hwndOwner As Long, _
ByVal
nFolder As Long, _
pidl As
ITEMIDLIST) _
As Long
Private Declare Function SHGetPathFromIDList Lib "Shell32.dll" Alias
"SHGetPathFromIDListA" _
(ByVal
pidl
As Long, _
ByVal
pszPath As String) _
As Long
Private Type ****EMID
cb As Long
abID As Byte
End Type
Private Type ITEMIDLIST
mkid As ****EMID
End Type
Private Const MAX_PATH As Integer = 260
Private Const CSIDL_DOCUMENTS = 5 '// My Documents
Private Sub CommandButton1_Click()
Dim nShell As Shell32.Shell
Dim nFolder As Shell32.Folder
Dim i As Long
Dim strFileName As Variant
Dim FileCount As Long
Dim RealFolderPath As String
RealFolderPath = fGetSpecialFolder(CSIDL_DOCUMENTS)
Set nShell = New Shell32.Shell
Set nFolder = nShell.NameSpace(RealFolderPath)
If nFolder Is Nothing Then
MsgBox "Invalid folder"
Exit Sub
End If
With ActiveSheet
.Cells.ClearContents
With .Range("A1")
For i = 0 To 39
.Offset(0, i) = nFolder.GetDetailsOf(0, i)
Next
For Each strFileName In nFolder.Items
If nFolder.GetDetailsOf(strFileName, 3) = "File Folder"
Then
'Build a list of folders to call this function
recursively
End If
For i = 0 To 39
.Offset(FileCount + 1, i) =
nFolder.GetDetailsOf(strFileName, i)
Next
FileCount = FileCount + 1
Next
End With
End With
End Sub
Public Function fGetSpecialFolder(CSIDL As Long) As String
Dim sPath As String
Dim IDL As ITEMIDLIST
'
' Retrieve info about system folders such as the "Recent Documents"
folder.
' Info is stored in the IDL structure.
'
fGetSpecialFolder = ""
If SHGetSpecialFolderLocation(Application.Hwnd, CSIDL, IDL) = 0 Then
'
' Get the path from the ID list, and return the folder.
'
sPath = Space$(MAX_PATH)
If SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal sPath) Then
fGetSpecialFolder = Left$(sPath, InStr(sPath, vbNullChar) - 1)
& ""
End If
End If
End Function
'</Code
NickHK
Alan wrote:
I think i have managed to cobble a bit of code together that will allow me to
get all file attributes from all files with a folder... however I would seek
to call this routine for every folde in a directory and as a result I am
seeking to use a string variable for the objShell.Namespace declaration...
However I get errors
Run time error 91 ... Object Variable or withblock variable unset
If I enter a single directory string in place of the variable "C:\My
Documents" it works fine ??
My Code is
Public Sub getattributes(strFolderPath As String)
Dim arrHeaders(40)
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(strFolderPath)
For i = 0 To 39
arrHeaders(i) = objFolder.GetDetailsOf(objFolder.Items, i)
Range("A1").Select
ActiveCell.Offset(0, i) = arrHeaders(i)
Next
ActiveCell(2, 1).Select
For Each strFileName In objFolder.Items
For i = 0 To 39
ActiveCell.Offset(0, i) = objFolder.GetDetailsOf(strFileName, i)
Next
ActiveCell.Offset(1, 0).Select
Next
End Sub
Any help with this variable or a way round this would be appreciated
Regards