Directories and subdirectories into EXCEL

Question

0.00/5 (No votes)

See more:

I'm new to this forum and am unfamiliar with VSC Scripts. I'm a novice with EXCEL VBS but can mutter my way thru most codes.

I had a code I used to use, on a Windows 7 OS but it doesn't seem to work any longer. It's been so long since i've used it I can't remember what the output was. To use it, I dropped a folder on top of the file and it opened the results i excel.

Below is the code:

What I have tried:

VB

  1  <pre>option explicit
  2  Dim fso
  3  Dim objFolder
  4  Dim colFiles
  5  Dim objFile
  6  Dim row
  7  Dim objXL
  8  Dim objVideo
  9  Dim dblSize
 10  Dim i
 11  
 12  function FileExt(FullPath)
 13  dim x, y
 14  dim tmpstring
 15  
 16    x = Len(FullPath)
 17    for y = x to 1 step -1
 18      if mid(FullPath, y, 1) = "." then
 19        tmpstring = mid(Fullpath, y+1)
 20        exit for
 21      end if
 22    next
 23  FileExt = tmpstring
 24  end function
 25  
 26  'WScript.echo "Argument Count: " & WScript.Arguments.Count
 27  set fso = CreateObject("Scripting.FileSystemObject")
 28  If fso.FolderExists(WScript.Arguments(0)) Then
 29    Set objFolder = fso.GetFolder(WScript.Arguments(0))
 30  	 
 31    'Create Excel Object
 32    set objXL = WScript.CreateObject("Excel.Application")
 33    'Show it to the user
 34    objXL.Visible = true
 35    'Add a workbook
 36    objXL.WorkBooks.Add()
 37    'Add a worksheet
 38    'objXL.Sheets.Add()
 39    objXL.Columns("B:B").Select
 40    objXL.Selection.NumberFormat = "0.00"
 41    objXL.Columns("D:D").Select
 42    objXL.Selection.HorizontalAlignment = -4108'xlCenter
 43    objXL.Range("A1").Select
 44  
 45    row = 1
 46  
 47    'loop through folders, add files to collection
 48        Set colFiles = objFolder.Files
 49        For Each objFile In colFiles
 50          'WScript.Echo "file: " & objFile.Path
 51  	    'WScript.echo "file.name: " & objFile.name
 52  		
 53  		  objXL.Cells(row,1).Value = objFile.name
 54            'objXL.Cells(row, 2).Value = objFile.size
 55  		  dblSize = objFile.size
 56  		  i = 0
 57  		  Do Until dblSize < 1000
 58  			i = i + 1
 59  			dblSize = dblSize / 1024
 60  		  Loop
 61  		  objXL.Cells(row,2).Value = dblSize
 62  		  Select Case i
 63  			  Case 0
 64  				objXL.Cells(row,3) = "bytes"
 65  			  Case 1
 66  				objXL.Cells(row,3) = "kB"
 67  			  Case 2
 68  				objXL.Cells(row,3) = "MB"
 69  			  Case 3
 70  				objXL.Cells(row,3) = "GB"
 71  			  Case 4
 72  				objXL.Cells(row,3) = "TB"
 73  			  Case Else
 74  				objXL.Cells(row,3) = "unknown"
 75  		  End Select
 76            row = row + 1
 77  		'end if
 78        Next
 79  	  
 80  	'cleanup  
 81      set objFolder = nothing
 82      set colFiles = nothing
 83      set objFile = nothing
 84  	set objVideo = nothing
 85  	set objXL = nothing
 86  	WScript.echo "Processing Complete"
 87  Else
 88    WScript.Echo "whoops! an error occurred"
 89  end If 
 90  	set fso = nothing

I modified the code found from the response to a question posted on this forum:
VB Script to list directory folders and subfolders - export to excel with indented tree structure[^]

The modified code is:

VB

  1  Sub ShowSubFolders (Folder) 
  2  	column = column + 1
  3  
  4  	For Each Subfolder in Folder.SubFolders 
  5  		ObjXL.ActiveSheet.Cells(row,column).Value = Subfolder.Path
  6  		ObjXL.ActiveSheet.Cells(row,column).select
  7  		'CAFLink = Subfolder.Path 
  8  		'ObjXL.Workbooks(1).Worksheets(1).Hyperlinks.Add ObjXL.Selection, CAFLink 
  9  		row = row + 1
 10  		ShowSubFolders Subfolder
 11  	Next 
 12  	
 13  	ShowFiles Folder
 14  		
 15  	column = column - 1
 16  
 17  End Sub 
 18  
 19  Sub ShowFiles (Folder)
 20  	
 21  	set files = folder.Files
 22  	For Each file in files
 23  		ObjXL.ActiveSheet.Cells(row,column).Value = file.Name
 24  		ObjXL.ActiveSheet.Cells(row,column).select
 25  		'CAFLink = Folder.Path+"\"+file.name
 26  		'ObjXL.Workbooks(1).Worksheets(1).Hyperlinks.Add ObjXL.Selection, CAFLink 
 27  		row = row + 1
 28  	next
 29  End Sub
 30  
 31  ' Get CAF Path from user (rootfolder)
 32  rootfolder = Inputbox("Enter CAF or folder path: " & chr(10) _
 33  	& "(e.g.\\Server\Root Folder Name\Folder\etc\)", _
 34  	"Directory Tree Generator", "C:\Temp\")
 35  'Run ShowSubFolders if something was entered in the CAF directory field, else just end
 36  if rootfolder <> "" Then 
 37  
 38  	'outputFile = "C:\Temp\" & Year(now) & Month(now) & Day(now) & "DIR_MAP_V1.0.xls"
 39  	outputFolder = "C:\Script Results\"
 40  	outputFile = "Folder Tree.xls"
 41  	outputTotal=outputFolder+outputFile
 42  
 43  	'check if folder exists, if not, create it
 44  	dim filesys, newfolder
 45  	set filesys=CreateObject("Scripting.FileSystemObject")
 46  	If  Not filesys.FolderExists(outputFolder) Then
 47  	   newfolder = filesys.CreateFolder (outputFolder)
 48  	End If
 49  	
 50  	strComputer = "."
 51  	Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
 52  	Set fso = CreateObject("scripting.filesystemobject")
 53  	if fso.fileexists(outputTotal) then fso.deletefile(outputTotal)
 54  	'Create Excel workbook
 55  	set objXL = CreateObject( "Excel.Application" )
 56  	objXL.Visible = False
 57  	objXL.WorkBooks.Add
 58  	'Counter 1 for writing in cell A1 within the excel workbook
 59  	column = 0
 60  	row = 1
 61  	'Run ShowSubfolders
 62  	ShowSubfolders FSO.GetFolder(rootfolder)
 63  	'Lay out for Excel workbook (top 4 rows as header)
 64  	objXL.Range("A1").Select
 65  	objXL.Selection.EntireRow.Insert
 66  	objXL.Selection.EntireRow.Insert
 67  	objXL.Selection.EntireRow.Insert
 68  	objXL.Selection.EntireRow.Insert
 69  	objXL.Columns(1).ColumnWidth = 60
 70  	objXL.Columns(2).ColumnWidth = 40
 71  	objXL.Columns(3).ColumnWidth = 40
 72  	objXL.Columns(4).ColumnWidth = 40
 73  	objXL.Range("A1").NumberFormat = "d-m-yyyy"
 74  	objXL.Range("A1:A3").Select
 75  	objXL.Selection.Font.Bold = True
 76  	objXL.Range("A1:B3").Select
 77  	objXL.Selection.Font.ColorIndex = 5
 78  	objXL.Range("A2").Select
 79  	ObjXL.ActiveSheet.Cells(1,1).Value = Day(now) & "-" & Month(now) & "-"& Year(now)
 80  	ObjXL.ActiveSheet.Cells(2,1).Value = UCase(rootfolder)
 81  	objXL.Range("A1").Select
 82  	objXL.Selection.Font.Bold = True
 83  	'Finally close the workbook
 84  	ObjXL.ActiveWorkbook.SaveAs(outputTotal)
 85  	ObjXL.Application.Quit
 86  	Set ObjXL = Nothing
 87  	
 88  	Finished = Msgbox ("File Map Generated Here:" & Chr(10) _
 89  		& outputfile & ".", 64, "File Map Generator")
 90  	'Message when finished
 91  	'Set WshShell = CreateObject("WScript.Shell")
 92  	'Finished = Msgbox ("Folder Map Generated Here:" & Chr(10) _
 93  		'& outputTotal & "." & Chr(10) _
 94  		'& "Do you want to open the Folder Map now?", 65, "DIRECTORY Map Generator")
 95  	'if Finished = 1 then 
 96  	
 97  	'CreateObject("WScript.Shell").Run outputTotal	
 98  	'WshShell.Run "excel " & outputTotal
 99  	
100  	
101  end if

When drop a directory on the script, it' prompts me for directory so I enter the directory path:F:\Movies and then the OK button.

It returns an error
Script: C:\Utilities\Batch Files\Option 2.vbx
Line: 4
Char: 2
Error: The file or directory is corrupted and unreadable.
Code: 8070570
Source: (null)

I'm not sure where this error is...Any help would be appreciated.

Posted 19-Mar-23 5:22am

Texas_Dan

Updated 22-Mar-23 6:02am

v5

Add a Solution

Comments

Dave Kreskowiak 19-Mar-23 11:53am

If this is VBScript, why is the extension on the filename ".vbx"?

Which line is line 4? And the code around it...

Texas_Dan 19-Mar-23 12:54pm

I just ran the script again and the error I noted above is a typo...it should have been "vbx"

The error is from the second script. Line 4 is:

For Each Subfolder in Folder.SubFolders

Maybe the "." should be between the "Folder" and "SubFolder"?

1 solution

Add a Solution

This content, along with any associated source code and files, is licensed under The Code Project Open License (CPOL)

CHill60 · Answer 1 · 2023-03-22T06:02:00

A few points:
- That script will never work with the .vbx extension - it should be .vbs to run VBScript. Last time I saw .vbx it was in a VB6 project and you don't want to go there.

- That script works for me as a .vbs, so if you are getting that error it may be that it is indeed corrupted. I can't replicate your exact circumstances. Do you have access to all sub-folders of F:\Movies for example.

- I do get an error similar in wording when I try to open the output - you should be using a .xlsx file for more modern versions of Excel.

- To answer your question of "Maybe the "." should be between the "Folder" and "SubFolder"?" - No, it should not. The syntax of VBScript is well documented, you can look that one up.

- The exception is being thrown at that line because it has come across a folder that it can't handle - try debugging the script - the simplest way is to msgbox each folder name immediately after that line. Take note of the last one that was successful and then see what is wrong with the "next" folder.

Alternatively, paste the script into an Excel workbook VBA project (Alt-F11 in a blank spreadsheet). Move the main part of the script into a Sub, declare the variables used in the sub-functions and step through the code (F8) there - examine the variables in either the immediate or watch windows

e.g

VB

Dim ObjXL As Object
Dim Row As Long, column As Long
Sub demo()

' Get CAF Path from user (rootfolder)
.. etc

Directories and subdirectories into EXCEL

1 solution

Solution 2

Add your solution here

Preview 0

Directories and subdirectories into EXCEL

1 solution

Solution 2

Add your solution here

Preview 0

Existing Members

...or Join us