ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   CreateObject - Namespace variable (https://www.excelbanter.com/excel-programming/380598-re-createobject-namespace-variable.html)

[email protected]

CreateObject - Namespace variable
 
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




All times are GMT +1. The time now is 04:38 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com