need a script to take a DIR list to XLSX

[Mr_J]

i've posted here too:

 

Macro to list Directories in various location - per worksheet

 

but basically i would like a script/macro that takes the directory listings of variou server shares and put them in one excel spreadsheet i can then search through - an index if you like.

 

has anyone got anything, or know of a way?

 

J

[tekins]

You can dir > filename.txt to get the directory to a file if that's any help, I'm sure you could use a script/macro in excel to auto import (possibly).

[Mr_J]

i tried that, didnt get it working

 

 

 

Dim fPath

Dim fCSV

 

 

Set xl = CreateObject("Excel.Application")

xl.Visible = True

 

Dim wbCSV

Dim wbMST

 

Set wbMST = xl.ActiveWorkbook

fPath = "C:\csv\" 'path to CSV files, include the final \

Application.ScreenUpdating = False 'speed up macro

Application.DisplayAlerts = False 'no error messages, take default answers

fCSV = Dir(fPath & "*.csv") 'start the CSV file listing

 

Do While Len(fCSV) > 0

Set wbCSV = Workbooks.Open(fPath & fCSV) 'open a CSV file

'delete existing sheet in Mstr

If Evaluate("ISREF('[" & wbMST.Name & "]" & ActiveSheet.Name & "'!A1)") Then

wbMST.Sheets(ActiveSheet.Name).Delete

End If

ActiveSheet.Move After:=wbMST.Sheets(wbMST.Sheets.Count) 'move new sheet into Mstr

 

fCSV = Dir 'ready next CSV

Loop

 

Application.ScreenUpdating = True

Set wbCSV = Nothing

[LosOjos]

Here you go, this will create a file called file_list.xlsx inside the folder you run the script on (drag and drop the folder on top of the script file to run it_:

 

Option Explicit

Dim Arg 			'Script argument
Dim FSO			'File System Object
Dim oFol			'Folder object
Dim oFil			'File object
Dim oFils		'Files
Dim myExcel		'Excel object
Dim myWorkbook		'Workbook object
Dim mySheet			'new worksheet
Dim filePath	'Path to file (need for Excel to open the file)
Dim x


'Check arguments
If WScript.Arguments.Length < 1 Then
WScript.Quit
End If 

Set FSO = CreateObject("Scripting.FileSystemObject")
Arg = WScript.Arguments(0)
If FSO.FolderExists(Arg) = False Then
  Set FSO = Nothing
  WScript.Quit
End If

Set myExcel = CreateObject("Excel.Application")
myExcel.Visible = True
myExcel.DisplayAlerts = False

'Get folder informaton
Set oFol = FSO.GetFolder(Arg)

Set myWorkbook = myExcel.Workbooks.Add()
Set mySheet = myWorkbook.Sheets.Add()

x=0
Set oFils = oFol.Files
For Each oFil in oFils  '-- enumerate files in the folder using For/Each. Each oFil is a File object.
mySheet.Range("$A$1").Offset(x, 0).Value = oFil.Name
x = x + 1
Next 

mySheet.Columns("A:A").EntireColumn.AutoFit

myWorkbook.SaveAs oFol & "/file_list.xlsx"
myWorkbook.Close False
Set mySheet = Nothing
Set myWorkbook = Nothing

myExcel.DisplayAlerts = True
myExcel.Application.Quit
Set myExcel = Nothing
Set oFils = Nothing
Set oFol = Nothing

[Mr_J]

thanks LosOjos - very nice, but it only gets the last item in the folder - and its getting files, rather that just folders. (so the XLSX file just had one line, with an MSI file in A1, despite there being 50+ folders).

 

also the output is saved in the remote location, not the local location of where i am running the script from (C:\)

 

any pointers would be greatly appreciated!

 

J

[LosOjos]

thanks LosOjos - very nice, but it only gets the last item in the folder - and its getting files, rather that just folders. (so the XLSX file just had one line, with an MSI file in A1, despite there being 50+ folders).

 

also the output is saved in the remote location, not the local location of where i am running the script from (C:\)

 

any pointers would be greatly appreciated!

 

J

 

The file location is an easy fix - just edit the argument after myWorkbook.SaveAs to set the location and filename. Not sure why it's only displaying the last item in a folder though - it works fine for me listing all files in a folder.

 

It'll need a little modification to display the contents of subfolders too. Before I tweak it, what format would you want it in?

 

My automatic response would be something like this:

file_at_root.txt
file2_at_root.txt
sub/file1.txt
sub/file2.txt
sub/sub2/file.txt

[Mr_J]

Thanks again!

 

i dont want subfolders, just the directories that are in the one folder...

 

\\server1\share1

 

I'll then modify it for the other 30+ servers i have.

 

its only listing FILES not DIRECTORIES - its the directories i need, sorry!

 

tried changing the saveas and i get "SaveAs method of workbook class failed" - i've changed it to:

myWorkbook.SaveAs oFol & "c:\file_list.xlsx"

[LosOjos]

OK, this should do it for you. Run it from the CLI (did it like this so you can write a BAT to call it on any folders you want):

 

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''  dirtoxlsx.vbs																		''
''  Usage: dirtoxlsx.vbs /Root:"X:\Some\Folder" /SaveAs:"X:\filename.xlsx" [/showFiles]	''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Option Explicit

Dim Root 			'Script argument
Dim FSO			'File System Object
Dim oFol			'Folder object
Dim oSubFol
Dim oFil			'File object
Dim oFils		'Files
Dim myExcel		'Excel object
Dim myWorkbook		'Workbook object
Dim mySheet			'new worksheet
Dim filePath	'Path to file (need for Excel to open the file)
Dim lineCount
Dim NamedArgs

Set NamedArgs = WScript.Arguments.Named
'Check arguments
If NamedArgs.Exists("Root") = False Or NamedArgs.Exists("SaveAs") = False Then
WScript.Echo "Usage: dirtoxlsx.vbs /Root:""X:\Some\Folder"" /SaveAs:""X:\filename.xlsx"" [/showFiles]"
WScript.Quit
End If 

Set FSO = CreateObject("Scripting.FileSystemObject")
Root = NamedArgs.Item("Root")
If FSO.FolderExists(Root) = False Then
  Set FSO = Nothing
  WScript.Echo "The folder " & Root & " does not exist"
  WScript.Quit
End If

Set myExcel = CreateObject("Excel.Application")
myExcel.Visible = True
myExcel.DisplayAlerts = False

'Get folder informaton
Set oFol = FSO.GetFolder(Root)

Set myWorkbook = myExcel.Workbooks.Add()
Set mySheet = myWorkbook.Sheets.Add()

lineCount = 0
mySheet.Range("$A$1").Offset(lineCount, 0).Value = "FOLDER"
mySheet.Range("$A$1").Offset(lineCount, 1).Value = oFol
lineCount = lineCount + 1
Iterate oFol, mySheet, lineCount

myWorkbook.SaveAs NamedArgs.Item("SaveAs")
myWorkbook.Close False
Set mySheet = Nothing
Set myWorkbook = Nothing

myExcel.DisplayAlerts = True
myExcel.Application.Quit
Set myExcel = Nothing
Set oFils = Nothing
Set oFol = Nothing

Sub Iterate(oFol, ByRef mySheet, ByRef lineCount)
if NamedArgs.Exists("ShowFiles") Then
	Set oFils = oFol.Files
	For Each oFil in oFils  '-- enumerate files in the folder using For/Each. Each oFil is a File object.
		mySheet.Range("$A$1").Offset(lineCount, 0).Value = "FILE"
		mySheet.Range("$A$1").Offset(lineCount, 1).Value = oFil
		lineCount = lineCount + 1
	Next 
End If

For Each oSubFol in oFol.SubFolders
	mySheet.Range("$A$1").Offset(lineCount, 0).Value = "FOLDER"
	mySheet.Range("$A$1").Offset(lineCount, 1).Value = oSubFol
	lineCount = lineCount + 1
	Iterate oSubFol, mySheet, lineCount
Next
End Sub

 

Call the script with the following arguments:

• /Root: - the path to the root folder to run the script on
  
• /SaveAs: - the name of the file to save to (WARNING: IT WILL OVERWRITE AN EXISTING FILE)
  
• /ShowFiles - Optional, add this option to display files in the list as well as folders
  

[LosOjos]

Did that last script help?

[mac_shinobi]

something like so :

 

Recursion And The FileSystemObject

 

Need to do the steps explained on this site : excel - How do I use FileSystemObject in VBA? - Stack Overflow

 

 

1.) Within Excel you need to set a reference to the VB script run-time library.

2.) The relevant file is usually located at \Windows\System32\scrrun.dll

3.) To reference this file, load the Visual Basic Editor (ALT-F11) Select Tools -> References from the drop-down menu. A listbox of available references will be displayed Tick the check-box next to 'Microsoft Scripting Runtime'

 

The full name and path of the scrrun.dll file will be displayed below the listbox Click on the OK button

@Mr_J - as above curious how you are getting on with this

 

Thanks

Edited July 10, 2013 by mac_shinobi

[Mr_J]

looking great, thanks for that!

 

is there an easy way to specify multiple folders? OR call the same script for various folders in the BAT file, but append the XLSX file instead of creating a new one?

 

also - i dont want subfolders, just the folders that are in the folder i specify. I tried commenting this out:

 

 

'For Each oSubFol in oFol.SubFolders

'mySheet.Range("$A$1").Offset(lineCount, 0).Value = "FOLDER"

'mySheet.Range("$A$1").Offset(lineCount, 1).Value = oSubFol

'lineCount = lineCount + 1

'Iterate oSubFol, mySheet, lineCount

'Next

 

but then i only got one result - the folder i specify!

Edited July 11, 2013 by Mr_J

[LosOjos]

looking great, thanks for that!

 

is there an easy way to specify multiple folders? OR call the same script for various folders in the BAT file, but append the XLSX file instead of creating a new one?

 

also - i dont want subfolders, just the folders that are in the folder i specify. I tried commenting this out:

 

 

'For Each oSubFol in oFol.SubFolders

'mySheet.Range("$A$1").Offset(lineCount, 0).Value = "FOLDER"

'mySheet.Range("$A$1").Offset(lineCount, 1).Value = oSubFol

'lineCount = lineCount + 1

'Iterate oSubFol, mySheet, lineCount

'Next

 

but then i only got one result - the folder i specify!

 

To only show the folders inside your root folder, just comment out the call to Iterate in that loop i.e.:

 

For Each oSubFol in oFol.SubFolders
mySheet.Range("$A$1").Offset(lineCount, 0).Value = "FOLDER"
mySheet.Range("$A$1").Offset(lineCount, 1).Value = oSubFol
lineCount = lineCount + 1
'Iterate oSubFol, mySheet, lineCount '<--- this line is commented out, so the script won't run on all subfolders
Next

 

To specify multiple folders, you'd need a BAT script with a separate call to the VBS script for each folder.

 

As for appending the XLSX - give me 5 minutes to update the script

[Mr_J]

can't thank you enough for this! its going to make a huge difference!

[LosOjos]

OK, here's new improved code for you. If the file you specify in SaveAs already exists, it'll append it (on a sheet called "DIRLIST"), otherwise it'll create a new file. I've also added a new argument, ShowSubFolders - add that argument to have the script drill down in to all subfolders, leave it out if you just want your root folder and the folders directly inside it

 

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''  dirtoxlsx.vbs																						''
''  Usage: dirtoxlsx.vbs /Root:"X:\Some\Folder" /SaveAs:"X:\filename.xlsx" [/showFiles /ShowSubFolders]	''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Option Explicit

Dim Root 			'Script argument
Dim SaveAs
Dim FSO			'File System Object
Dim oFol			'Folder object
Dim oSubFol
Dim oFil			'File object
Dim oFils		'Files
Dim myExcel		'Excel object
Dim myWorkbook		'Workbook object
Dim mySheet			'new worksheet
Dim sh
Dim filePath	'Path to file (need for Excel to open the file)
Dim lineCount
Dim NamedArgs

Set NamedArgs = WScript.Arguments.Named
'Check arguments
If NamedArgs.Exists("Root") = False Or NamedArgs.Exists("SaveAs") = False Then
WScript.Echo "Usage: dirtoxlsx.vbs /Root:""X:\Some\Folder"" /SaveAs:""X:\filename.xlsx"" [/showFiles /ShowSubFolders]"
WScript.Quit
End If 

Set FSO = CreateObject("Scripting.FileSystemObject")
Root = NamedArgs.Item("Root")
If FSO.FolderExists(Root) = False Then
  Set FSO = Nothing
  WScript.Echo "The folder " & Root & " does not exist"
  WScript.Quit
End If

SaveAs = NamedArgs.Item("SaveAs")

Set myExcel = CreateObject("Excel.Application")
myExcel.Visible = True
myExcel.DisplayAlerts = False

'Get folder informaton
Set oFol = FSO.GetFolder(Root)

if FSO.FileExists(SaveAs) then
Set myWorkbook = myExcel.Workbooks.Open(SaveAs)
For Each sh In myWorkbook.Sheets
	If sh.Name="DIRLIST" then Set mySheet = sh
next
else
Set myWorkbook = myExcel.Workbooks.Add()
end if

If IsEmpty(mySheet) then
Set mySheet = myWorkbook.Sheets.Add()
mySheet.Name = "DIRLIST"
lineCount = 0
else
lineCount = mySheet.UsedRange.Rows.Count
end if

mySheet.Range("$A$1").Offset(lineCount, 0).Value = "FOLDER"
mySheet.Range("$A$1").Offset(lineCount, 1).Value = oFol
lineCount = lineCount + 1
Iterate oFol, mySheet, lineCount

myWorkbook.SaveAs NamedArgs.Item("SaveAs")
myWorkbook.Close False
Set mySheet = Nothing
Set myWorkbook = Nothing

myExcel.DisplayAlerts = True
myExcel.Application.Quit
Set myExcel = Nothing
Set oFils = Nothing
Set oFol = Nothing

Sub Iterate(oFol, ByRef mySheet, ByRef lineCount)
On Error Resume Next

if NamedArgs.Exists("ShowFiles") Then
	Set oFils = oFol.Files
	For Each oFil in oFils  '-- enumerate files in the folder using For/Each. Each oFil is a File object.
		mySheet.Range("$A$1").Offset(lineCount, 0).Value = "FILE"
		mySheet.Range("$A$1").Offset(lineCount, 1).Value = oFil
		lineCount = lineCount + 1
	Next 
End If

For Each oSubFol in oFol.SubFolders
	mySheet.Range("$A$1").Offset(lineCount, 0).Value = "FOLDER"
	mySheet.Range("$A$1").Offset(lineCount, 1).Value = oSubFol
	lineCount = lineCount + 1
	If NamedArgs.Exists("ShowSubFolders") Then Iterate oSubFol, mySheet, lineCount
Next
End Sub

 

EDIT:

one last piece of advice - if you're going to be calling this from a BAT then I suggest calling it like so (assuming you save the script as dirtoxlsx.vbs):

 

cscript dirtoxlsx.vbs /Root:\\server\Folder\Example /SaveAs:C:\example\dir.xlsx

 

The reason being that if you don't call it with cscript, any errors will be windows dialogs causing the script (and in turn your BAT) to stall until the user presses OK. Obviously no good for an unattended run! Using cscript ensures all output is directed to the console.

 

As an added bonus, if you were to run this as a scheduled task, you can redirect the output to a text file to create a log so you can see if anything went wrong e.g.

 

cscript dirtoxlsx.vbs /Root:\\server\Folder\Example /SaveAs:C:\example\dir.xlsx > C:\example\log.txt

 

The result would be any output from the script would be stored in the log.txt file for you to check when you get chance

Edited July 11, 2013 by LosOjos

[Mr_J]

awesome, thanks so much!

 

i'm sure this is going to be useful for a few people!

 

J

[LosOjos]

@Mr_J - you're welcome, I love little challenges like this they keep me sane!

 

Also, did anyone spot my deliberate mistake?

 

cscript dirtoxlsx.vbs /Root:\\server\Folder\Example /SaveAs:C:\example\dir.xlsx > C:\example\log.txt

 

That should have been a double right operator (>>) to append to log.txt rather than overwrite

 

cscript dirtoxlsx.vbs /Root:\\server\Folder\Example /SaveAs:C:\example\dir.xlsx >> C:\example\log.txt

[pcstru]

Just for interest (for small values of interest), in powershell a csv of directories with various attributes listed for each directory could be produced by :

 

Get-ChildItem "\\\" * | where {$_.PsIsContainer} | Export-Csv c:\tmp\dirlist.csv -notype

 

And if you want to recursively list the folders add the -r switch.

 

Get-ChildItem "\\\" * -r | where {$_.PsIsContainer} | Export-Csv c:\tmp\dirlist.csv -notype

 

Yea - I hate powershell too.

Edited July 12, 2013 by pcstru

[Mr_J]

of course i spotted it @LosOjos! *CougH* :s

 

i just didn't want to make you feel bad!

 

thanks again!