PDA

View Full Version : Listing folder names in a column



nightzirk
08-28-2013, 07:05 AM
Hello everyone, I am very new to VBA! I work in tech-support at a local company, and today I've gotten an assignment that feels like it would take ages to do manually. Basically, I am to list a bunch of folders (1,001 to be exact) along with their size in megabytes and a boolean variable indicating whether or not the folder has a relevant user in AD. The last part probably has to be done manually, but I feel like there is probably some very simple script to automate the first two requirements. The format should be like this: Column A (Name) lists the name of each folder (they are all in the same directory) and column B lists the size in MB of that folder. The only programming I know is in C++, so any help to get this to work would be greatly appreciated.

Kenneth Hobs
08-28-2013, 07:31 AM
Welcome to the forum!

In the Visual Basic Editor (VBE, Alt+F11):
In the commented link, Import that Module or copy and paste the code. These are needed for the speedon and speedoff routines to work.
Add the reference as commented.
Obviously, change "x:\" to your path.
Insert the speed module or another, this code.


Sub ListFoldersAndInfo()
' Tools > References > Microsoft Scripting Runtime > OK
Dim fso As FileSystemObject, fldr As Folder
Dim fPath As String, r As Range

fPath = "x:\"

On Error GoTo TheEnd
' http://vbaexpress.com/kb/getarticle.php?kb_id=1035
SpeedOn

Set fso = New FileSystemObject
Set r = Range("A2")
For Each fldr In fso.GetFolder(fPath).SubFolders
r.Value2 = fldr.Name
' 1 Byte = 8 Bit
' 1 Kilobyte = 1,024 Bytes
' 1 Megabyte = 1,048,576 Bytes
' 1 Gigabyte = 1,073,741,824 Bytes
' 1 Terabyte = 1,099,511,627,776 Bytes
r.Offset(0, 1).Value2 = Round(fldr.Size / 1048576, 0)
Set r = r.Offset(1)
Next fldr

TheEnd:
SpeedOff
End Sub

nightzirk
08-28-2013, 08:01 AM
Hi Kenneth, thanks for the warm welcome! Your code looks like it could definitely do the job, but on compilation I'm getting the error "User-defined type not defined" and it points to Sub ListFoldersAndInfo() Maybe I imported the speedon and speedoff routines wrong though. What I did was to create a new module containing SpeedOn, SpeedOff and ListFoldersAndInfo Here is an image of the exact setup: i(dot)imgur(dot)com/m2P6bPc.png Could it be because I'm using a network location? Thanks in advance, nightzirk

Kenneth Hobs
08-28-2013, 08:15 AM
Sounds like you did not add the reference to the Microsoft Scripting Runtime. Tools means click the Tools menu in VBE.

In the Sub in the VBE, you can use F8 to debug line by line to find an error at run time. I like to Compile programs before running. You can add the Compile button to the VBE toolbar. I recommend adding Option Explicit as the first line of code in Modules. You can make VBE do that for you in the Tools > Options > Require Variable Declaration > OK.

When early bound objects are used, if defined in the reference, when you Dim them, the object then has intellisense. This intellisense is especially helpful if you don't know all of the properties and methods available to the object. Once you get the reference set, delete the period in fso.Getfolder and retype the period to see how intellisense works. That is if you have Autolist set in Tools > Options. It is checked by default.

I have attached an example file. The Go Advanced button in this forum has a paperclip icon to let you attach a file.

I normally run a Sub by clicking the run button or F5 while in the Sub.

I could have shown you a VBA method without FSO. FSO is fairly common though. To get help with FSO, WScript, JScript, and such, see this nice help file. http://www.microsoft.com/en-us/download/details.aspx?id=2764

nightzirk
08-28-2013, 08:20 AM
Yes, I imagine that you are right. I'm on my way home from work now, but I'll have a look at that tomorrow. Thanks for your help!

nightzirk
08-29-2013, 05:06 AM
Alright, I ran the script and it seems to work perfectly. However, I noticed that there are a few appData folders that even my admin account does not have access to view. It shouldn't be too much of a problem though, as the size of those folders is minimal. Would it be possible to just skip those folders all-together?

What I mean is that I want to continue, even when there is a folder that the macro doesn't have access to.

Kenneth Hobs
08-29-2013, 05:45 AM
I don't understand. Does it error for one of those folders or does it just skip as you wanted?

Maybe, you can use Attributes to help make decisions. e.g.

r.Offset(0, 2).Value2 = (fldr.Attributes And System) <> 0 'True, Attribute is set

nightzirk
08-29-2013, 06:37 AM
Sorry, I was not making myself clear.

What I mean is that some folders have subfolders that I don't have access to read. This causes the script to halt unexpectedly. i(dot)imgur(dot)com/5DBJh6K.png

As you can see, it stops at the first folder where I don't have full read permissions (the appdata folder in "agnar" is out of my spectrum).

Here's some pseudocode of approximately what I want:

if(can't read subfolder)
skip subfolder

Something like that. Or if that doesn't work, then:

if(can't read subfolder)
skip folder and write error

As it is now, the script completely halts as soon as it reaches an appdata folder.

Kenneth Hobs
08-29-2013, 06:50 AM
Rather than doing If's for each subfolder, I would set the label to goto on error to the line before the Next fldr. After the loop, I would then get the range of A1 to the last cell in column A. From the bottom up, I would then delete rows where the cells in A were "".

If I have time later tonight, I will show you how to do these two things.

Kenneth Hobs
08-29-2013, 03:47 PM
Maybe this will help some. Hopefully, it will list the Accountname (owner) of the subfolder and the folder name at least. I am not sure if owner or a folder attribute will help with the permission issue.


Sub ListFoldersAndInfo() ' Tools > References > Microsoft Scripting Runtime > OK
Dim fso As FileSystemObject, fldr As Folder
Dim fPath As String, r As Range

fPath = "c:\Windows"

On Error GoTo Nf
' http://vbaexpress.com/kb/getarticle.php?kb_id=1035
SpeedOn

Set fso = New FileSystemObject
Set r = Range("A2")
For Each fldr In fso.GetFolder(fPath).SubFolders
r.Offset(0, 3).Value2 = FileOwner(fldr.Path)
r.Value2 = fldr.Name
' 1 Byte = 8 Bit
' 1 Kilobyte = 1,024 Bytes
' 1 Megabyte = 1,048,576 Bytes
' 1 Gigabyte = 1,073,741,824 Bytes
' 1 Terabyte = 1,099,511,627,776 Bytes
r.Offset(0, 1).Value2 = Round(fldr.Size / 1048576, 0)
r.Offset(0, 2).Value2 = (fldr.Attributes And System) <> 0 'True, Attribute is set
Nf:
Set r = r.Offset(1)
Next fldr

TheEnd:
SpeedOff
End Sub


'http://www.microsoft.com/technet/scriptcenter/resources/qanda/oct04/hey1007.mspx
Function FileOwner(strFile) As String
Dim strComputer As String
Dim objWMIService As Object
Dim colItems As Object
Dim objItem As Variant
'Application.Volatile True
On Error Resume Next

strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")

Set colItems = objWMIService.ExecQuery _
("ASSOCIATORS OF {Win32_LogicalFileSecuritySetting='" & strFile & "'}" _
& " WHERE AssocClass=Win32_LogicalFileOwner ResultRole=Owner")

For Each objItem In colItems
'FileOwner = objItem.ReferencedDomainName
FileOwner = objItem.AccountName
Next
End Function

snb
08-30-2013, 02:53 AM
What about ?


Sub M_snb()
sn = Split(CreateObject("wscript.shell").exec("cmd /c Dir ""G:\OF\*."" /b").stdout.readall, vbCrLf)

For j = 0 To UBound(sn)
If Dir(sn(j), 16) = "" Then sn(j) = "~"
Next
sn = Filter(sn, "~", False)

Cells(1).Resize(UBound(sn) + 1) = Application.Transpose(sn)
End Sub

Kenneth Hobs
08-30-2013, 06:22 AM
Getting the subfolder name is not a problem. Getting the subfolder size can cause the permissions error. FSO methods can make trapping those errors a bit tricky sometimes.

If you don't mind flashing of the black screen while the shell is working, a shell method such as snb's example can work well.

Of course we can poke all of the subfolder names into an array using the fso method and write it to a range in one line of code as snb did.

I used snb's preferred method in this example. I used the shell's DIR command line switch of /ad to just list the subfolder names in the parent folder. Use /s if you want to find all subfolders.

My last c:\Windows subfolder has no name but has a size. I am not sure how that happens.

As before, set the reference to the Microsoft Scripting Runtime object. Change the value of sPath to suit.


Option Explicit

Sub snb_ken()
Dim fPath As String
Dim sn As Variant, i As Long
Dim fso As FileSystemObject

fPath = "c:\Windows"
Set fso = New FileSystemObject

sn = Split(CreateObject("wscript.shell").exec("cmd /c Dir " & """" & _
fPath & """" & " /ad/b").StdOut.ReadAll, vbCrLf)
Range("A1").Resize(UBound(sn) + 1) = Application.Transpose(sn)
'Debug.Print sn(UBound(sn))

On Error Resume Next
For i = LBound(sn) To UBound(sn)
sn(i) = Round(fso.GetFolder(fPath & "\" & sn(i)).Size / 1048576, 0)
Next i
Range("B1").Resize(UBound(sn) + 1) = Application.Transpose(sn)

'Debug.Print sn(UBound(sn))
Set fso = Nothing
End Sub