VBS Create Folder Method

[thoskins]

I have figured out how to create a single folder using VBS, but how do you create a subfolder whose parent folder doesn't exist yet. Do you first have to create the parent folder then the subfolder? We backup our files onto our network and somtimes the folders get nested up to five or six times. What I am trying to do is create a vbs that will save the file to my hard drive first and then duplicate the file path to save it on the network. I have successfully done this so far, but the network path has to already be there. ie if my hard drive path is c:camgmpt4t65ejectorrev_gz my network path would be k:camgmpt4t65ejectorrev_gz. I have been able to have the script tell me if the folder exists or not. I would like to be able to have it create the folder if it does not exist. I think the CreateFolder Method only allows you to create one folder at a time, but I'm not sure.

 

McamX MR1

Win XP

[Roger Martin from CNC Software]

thoskins,

 

The FSO model doesn't have a method to create nested folders.

 

I cannot take credit for this function, but it worked for me...

 

Say that "c:temp" already exists, and you want a new folder that is several levels deeper

 

Call it with your desired folder, like this -->

 

CreateDirectory("c:temptestsubfolder1subfolder2")

 

code:

---

Function CreateDirectory(dirName)

Dim aFolders, newFolder

Dim delim

Dim fso

Dim i

 

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

'Set up this delimiter to handle UNC paths

delim = "

_-_-"

dirname = replace(dirname,"",delim)

End If

 

aFolders = split(dirName, "")

 

If InStr(dirname,delim) Then

dirname = replace(aFolders(0),delim,"")

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)

newFolder = fso.BuildPath(newFolder, aFolders(i))

 

If Not fso.FolderExists(newFolder) Then

fso.CreateFolder newFolder

err.clear

End If

Next

End If

 

End Function

---

[thoskins]

Thanks Roger.

Thats just cool.

It worked first time.

Now for some fine tuning

[thoskins]

Here it is, my first useful script. It saves your currrent file to its original location and backs it up to a secondary location by changing the drive letter to whatever you like.

 

 

Code:

------------------------------------

 

'////////////////////////////////////////////////////////////////////////////////

'//

'// Author: Tim Hoskins with help from Roger Martin

'// Date: 04/08/2006

'// File Name: Saves file to current location and a secondary location

'//

'// Description: Mastercam VB Script

'//

'// Comments: It ain't pretty, but it works

'//

'////////////////////////////////////////////////////////////////////////////////

 

 

' -- Start Script

Call Main()

 

 

' ////////////////////

' Sub Declaration

' ////////////////////

Sub Main()

 

On Error Resume Next

 

Dim strBackupPath

Dim strOriginalPath, funame

Dim fname, fkname, show

Dim ndir, SearchChar, SearchString

Dim path, flength, npath

Dim newpath, MyPos, npathh

Dim pathnew

 

 

pathnew = "K:TOSHIBA_200" 'Prefix of the Secondary path to save file to

 

strOriginalPath = GetCurrentFileName 'Gets the name of the current Mastercam file

 

SearchString = strOriginalPath 'Stores the current name for other use

 

SearchChar = ""

 

MyPos = InstrRev(SearchString, SearchChar, -1, 1) 'Searches current file name for first instance of the search character and returns location its location in the string

 

flength = MyPos - 1

 

npath = left(SearchString, flength) 'Sets the variable to name of the folder on the hard drive

 

npathh = Mid(npath, 3, 200) 'Sets variable equal to the path minus the drive designation

 

newpath = pathnew + npathh 'Assembles the Secondary path

 

Call CreateDirectory(newpath) 'Calls the function to create the new Directory

 

fname = Mid(strOriginalPath, 3, 200) 'Gets filename minus drive designation

 

funame = Ucase(fname) 'Changes the case of name

 

fkname = Ucase(pathnew + funame) 'Assembles new file name

 

Call SaveMC(true) 'Saves the current file with the original name

 

Call SaveMCAs(fkname, true) 'Saves the file with the new filename

 

show = Ucase("FILE SAVED AS" + vbcr + strOriginalPath + vbCr + "AND" + vbCr + fkname)

 

ShowString(show)

 

 

 

 

 

 

End Sub

 

Function CreateDirectory(dirName)

Dim aFolders, newFolder

Dim delim

Dim fso

Dim i

 

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

'Set up this delimiter to handle UNC paths

delim = "-__-"

dirname = replace(dirname,"",delim)

End If

 

aFolders = split(dirName, "")

 

If InStr(dirname,delim) Then

dirname = replace(aFolders(0),delim,"")

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)

newFolder = fso.BuildPath(newFolder, aFolders(i))

 

If Not fso.FolderExists(newFolder) Then

fso.CreateFolder newFolder

err.clear

End If

Next

End If

 

End Function

------------------------------------------