Re: Creating subfolders at multiple levels by maximillianx
maximillianx
Thu Feb 23 14:58:22 CST 2006
Could you do a .readall method? You could parse against vbnewline
I don't know if this code is 100%, I just kinda whipped it up, hopefully you
can troubleshoot :)
Set textstream = objEntry.OpenAsTextStream(path, ForReading)
patharray = split(textstream.ReadAll,vbnewline)
for i = 0 to ubound patharray
msgbox "Processing " & trim(patharray(i))
MakeSureDirectoryTreeExists (trim(patharray(i)))
next
Oh, and to clarify, that function isn't mine, I hoisted it from a script
site somewhere...but I did modify it to work with long filenames/paths with
spaces in it, etc... :), so I guess a very small part of it is mine!
Rob
"Highlander" <tron9901@msn.com> wrote in message
news:1140723462.325695.123020@i40g2000cwc.googlegroups.com...
> Rob - your MakeSureDirectoryTreeExists Function is awesome! Exactly
> what I needed, thanks!
>
> When I test the Function in a standalone script - where I define the
> path in a variable, it works great:
>
> path = "c:\one\two\three"
> call MakeSureDirectoryTreeExists(path)
> Function MakeSureDirectoryTreeExists(dirName)
>
> And I'm also able to use the Function to process multiple paths that
> are in a text file:
>
> Const ForReading = 1
> Dim path
> Set objFSO = CreateObject("Scripting.FileSystemObject")
> Set objTextFile = objFSO.OpenTextFile("PathNames.txt", ForReading)
> Do
> path= objTextFile.ReadLine
> MakeSureDirectoryTreeExists (path)
> Loop until objTextFile.atEndofStream
> Function MakeSureDirectoryTreeExists(dirName)
>
> But I've run into a snag. I'm trying to get the Function to work in an
> HTA, where the value of the variable "path" is obtained from a
> textarea, and it's not working:
>
> Dim path
> path = document.all.textarea.value
> Set textstream = objEntry.OpenAsTextStream(path, ForReading)
> Do
> path = textstream.ReadLine
> MakeSureDirectoryTreeExists (path)
> Loop until objTextFile.atEndofStream
> Function MakeSureDirectoryTreeExists(dirName)
>
> The textarea input includes multiple lines, and looks like this:
>
> c:\one\two\three
> c:\one\two\three\four
> c:\one\two\three\four\five
>
> My code for this Do Loop is not correct. Do you know how I can
> configure a Do Loop to read each line of the textarea value and have
> your Function create the directory tree? Any suggestions would be
> greatly appreciated. Thanks!
>
> - Dave
>
> maximillianx wrote:
>> Hi there - Here is what I use, it works pretty well:
>>
>> Just call like this:
>>
>> MakeSureDireectoryTreeExists("c:\one\two\three")
>>
>> ' The MakeSureDirectoryTreeExists Function
>>
>> ' Although the FSO model doesn't have a direct method to create nested
>> ' folders, you can use the following function. This VBScript function
>> uses
>> ' VBScript's Split function to break the folder path it receives into
>> ' components. From those components, the MakeSureDirectoryTreeExists
>> ' creates subfolders, one at a time. Because the function checks for the
>> ' folder's existence before proceeding, you can pass it any tree, as long
>> as
>> ' you make sure that, after it returns, the entire tree exists as you
>> specified.
>> ' With the MakeSureDirectoryTreeExists function, a call such as
>>
>> ' MakeSureDirectoryTreeExists "C:\one\two\three"
>>
>> ' is legitimate and won't result in an error message.
>>
>> Function MakeSureDirectoryTreeExists(dirName)
>> Dim aFolders, newFolder
>> dim delim
>> ' Creates the FSO object.
>> Set fso = CreateObject("Scripting.FileSystemObject")
>>
>> ' Checks the folder's existence.
>> If Not fso.FolderExists(dirName) Then
>>
>> ' Splits the various components of the folder name.
>> If instr(dirname,"\\") then
>> 'I set up this delimiter to handle UNC paths
>> delim = "-_-_-_-"
>> dirname = replace(dirname,"\\",delim)
>> 'wscript.echo dirname
>> End if
>>
>> aFolders = split(dirName, "\")
>>
>> If InStr(dirname,delim) Then
>> dirname = replace(aFolders(0),delim,"\\")
>> 'wscript.echo "aFolders = " & dirname
>> End if
>>
>> ' Obtains the drive's root folder.
>>
>> newFolder = fso.BuildPath(dirname, "\")
>>
>> ' Scans each component in the array, and create the appropriate folder.
>> For i=1 to UBound(aFolders)
>> If IntDebug = 1 Then
>> strTempVar = "Checking to see if " & newfolder _
>> & " exists..."
>> Call writedebug(strtempvar)
>> End If
>> newFolder = fso.BuildPath(newFolder, aFolders(i))
>> 'wscript.echo newfolder
>>
>>
>> If Not fso.FolderExists(newFolder) Then
>> If IntDebug = 1 Then
>> strTempVar = "Creating " & newfolder
>> Call writedebug(strTempVar)
>> End If
>> fso.CreateFolder newFolder
>> err.clear
>> End If
>> Next
>> End If
>> End Function
>>
>> "Highlander" <tron9901@msn.com> wrote in message
>> news:1140625664.692396.125980@g44g2000cwa.googlegroups.com...
>> > Hello.
>> >
>> > I've got a script that creates subfolders at multiple levels, on a
>> > remote server:
>> >
>> > (watch for word-wrap)
>> > ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
>> > Dim strDestinationServer, strAppName, DestinationPath, strTicketNumber
>> > Dim Yearfrom, Monthfrom, Dayfrom, strDate, InstallPath, Sub1, Sub2,
>> > CodeSub1, Sub3
>> >
>> > strDestinationServer = "000-SERVER-05"
>> > strAppName = "Webteam"
>> > DestinationPath = "\\" & strDestinationServer & "\D$\Install\" &
>> > strAppName & "\Installs\"
>> > strTicketNumber = "7146"
>> >
>> > Yearfrom = Year(Date)
>> > Monthfrom = Month(Date)
>> > Dayfrom = Day(Date)
>> > strDate = Yearfrom & "_" & Monthfrom & "-" & Dayfrom
>> > InstallPath = strDate & "_Ticket_" & strTicketNumber
>> >
>> > Set objFSO = CreateObject("Scripting.FileSystemObject")
>> > IF NOT objFSO.FolderExists(DestinationPath & InstallPath) Then
>> > objFSO.CreateFolder(DestinationPath & InstallPath)
>> > End IF
>> >
>> > Sub1 = DestinationPath & InstallPath & "\D_Project\"
>> > IF NOT objFSO.FolderExists(Sub1) Then
>> > objFSO.CreateFolder(Sub1)
>> > End IF
>> >
>> > Sub2 = Sub1 & strAppName
>> > IF NOT objFSO.FolderExists(Sub2) Then
>> > objFSO.CreateFolder(Sub2)
>> > End IF
>> >
>> > CodeSub1 = "\Teamsite\"
>> >
>> > Sub3 = Sub2 & CodeSub1
>> > IF NOT objFSO.FolderExists(Sub3) Then
>> > objFSO.CreateFolder(Sub3)
>> > End IF
>> >
>> > strCMD = "EXPLORER.EXE"
>> > Set objShell = CreateObject("WScript.Shell")
>> > Set objWshScriptExec = objShell.Exec (strCMD & " " & Sub3)
>> >
>> > Set objFSO = nothing
>> > Set objShell = nothing
&g