Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations gkittelson on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Directory Structure output to text file 1

Status
Not open for further replies.

SQLScholar

Programmer
Aug 21, 2002
2,127
GB
Hey all,

I have written (borrowed large bits!) a script which is supposed to output the directory structure of the current directory to a text file. Please see below script:

Code:
On Error Resume Next

Dim arrFolders()
intSize = 0

strComputer = "."
strPath = Wscript.ScriptFullName

Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set objFSO = CreateObject("Scripting.FileSystemObject")

Set objFile = objFSO.GetFile(strPath)
strFolder2 = objFSO.GetParentFolderName(objFile)

strFolderName = strFolder2

GetSubFolders strFolderName

Sub GetSubFolders(strFolderName)
    Set colSubfolders = objWMIService.ExecQuery _
        ("Associators of {Win32_Directory.Name='" & strFolderName & "'} " _
            & "Where AssocClass = Win32_Subdirectory " _
                & "ResultRole = PartComponent")

    For Each objFolder in colSubfolders
        strFolderName = objFolder.Name
        ReDim Preserve arrFolders(intSize)
        arrFolders(intSize) = strFolderName
        intSize = intSize + 1
        GetSubFolders strFolderName
    Next
End Sub

set outputfile =  objFSO.OpenTextFile("DirectoryFilestructure.txt", 8, True)

For Each strFolder in arrFolders
    outputfile.writeline(strFolder)
Next
outputfile.close

Now it seems to work - other then it ends too quickly. It gets half way through documents and settings and stops (i.e. finishes doing that last loop.).

Cant see for the life of me why?

Can anyone sugguest?

Dan


----------------------------------------
Be who you are and say what you feel, because those who mind don't matter and those who matter don't mind - Dr. Seuss

Computer Science is no more about computers than astronomy is about telescopes - EW Dijkstra
----------------------------------------
 
What about the following changes ?
Code:
On Error Resume Next

Dim arrFolders()
intSize = 0

strComputer = "."
strPath = Wscript.ScriptFullName

Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set objFSO = CreateObject("Scripting.FileSystemObject")

Set objFile = objFSO.GetFile(strPath)
strFolder2 = objFSO.GetParentFolderName(objFile)

[!][s]strFolderName = strFolder2[/s][/!]

GetSubFolders [!]strFolder2[/!]

Sub GetSubFolders(strFolderName)
    Set colSubfolders = objWMIService.ExecQuery _
        ("Associators of {Win32_Directory.Name='" & strFolderName & "'} " _
            & "Where AssocClass = Win32_Subdirectory " _
                & "ResultRole = PartComponent")

    For Each objFolder in colSubfolders
[!][s]        strFolderName = objFolder.Name[/s][/!]
        ReDim Preserve arrFolders(intSize)
        arrFolders(intSize) = [!]objFolder.Name[/!]
        intSize = intSize + 1
        GetSubFolders [!]objFolder.Name[/!]
    Next
End Sub

set outputfile =  objFSO.OpenTextFile("DirectoryFilestructure.txt", 8, True)

For Each strFolder in arrFolders
    outputfile.writeline(strFolder)
Next
outputfile.close

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886
 
Hey PHV,

I tried your ammendments, but still got the same issue.

If if check the err.number at the end i get -2147217385.

Having trouble getting the description though. I am using msgbox err.description and am getting no messagebox.

----------------------------------------
Be who you are and say what you feel, because those who mind don't matter and those who matter don't mind - Dr. Seuss

Computer Science is no more about computers than astronomy is about telescopes - EW Dijkstra
----------------------------------------
 
What happens if you comment out the On Error Resume Next instruction ?

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886
 
I get

Line 28
char 5
error 0x80041017
code 80041017
Source (null)

----------------------------------------
Be who you are and say what you feel, because those who mind don't matter and those who matter don't mind - Dr. Seuss

Computer Science is no more about computers than astronomy is about telescopes - EW Dijkstra
----------------------------------------
 
And what is line 28 ?

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886
 
For Each objFolder in colSubfolders

----------------------------------------
Be who you are and say what you feel, because those who mind don't matter and those who matter don't mind - Dr. Seuss

Computer Science is no more about computers than astronomy is about telescopes - EW Dijkstra
----------------------------------------
 
Found this link which sounds like it solves my issue, but i dont know how to implement it.


----------------------------------------
Be who you are and say what you feel, because those who mind don't matter and those who matter don't mind - Dr. Seuss

Computer Science is no more about computers than astronomy is about telescopes - EW Dijkstra
----------------------------------------
 
Think i sussed it.

Will have to have a word with some of the guys here (i am quite new to this company) but i think the account i was using which i thought had full access.... doesnt.

Getting caught on certain folders.

Thanks for your help

STAR for effort on that one.

Dan

----------------------------------------
Be who you are and say what you feel, because those who mind don't matter and those who matter don't mind - Dr. Seuss

Computer Science is no more about computers than astronomy is about telescopes - EW Dijkstra
----------------------------------------
 
You could use DIR /A:D /B /S at a command prompt to confirm your suspicion. Redirect to a text file with > Filename.txt.
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top