VBS out of range error
I keep getting a Subscript out of range VBS error 800A0009 on the following script. Why?
Dim myName 'As String
Dim main_fldr 'As String
Dim subfldr1 'As String
Dim subfldr2 'As String
Dim lastrow 'As Integer
Dim cell 'As Object
Const xlUp = -4162 '(&HFFFFEFBE)
Set objWshShell = WScript.CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
strUserProfile = objWshShell.Environment("PROCESS")("UserProfile")
strNewDirectory = strUserProfile + "\My Documents\Students"
If objfso.FolderExists(strnewdirectory) = False Then
Set objFolder = objFSO.CreateFolder(strNewDirectory)
End If
subfldr1 = inputbox("Do you want to add a subfolder to the childs folder? Make sure you have an excel file called names with the names of all the children in it stored on C:drive before you start.", "Folder name", "add subfolder name here") 'folder1
subfldr2 = inputbox("What is the second foldername? These prompts are for the creation of project folders - for instance I add Assignment and Report as two subfolders. If you add nothing a folder will not be created", "Folder name", "") 'folder2
mynames = strUserProfile & "\My Documents\name.xls" 'location of the excel spreadsheet
worksheetname = "Sheet1" 'name of the worksheet within excel
Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open(mynames)
objExcel.Visible = False
Set ws = objExcel.activeworkbook.Worksheets(worksheetname)
objExcel.Displayalerts = False
'find the lastrow on the sheet
lastrow = ws.Range("A65536").End(xlUp).Row
'make the folders
For Each cell In ws.Range("A5:A" & lastrow)
myName = cell.Value & "_" & cell.Offset(0, 1).Value
'Call MkDir(strNewDirectory & "\") remove this.. its created already
Call MkDir(strNewDirectory & "\" & myName & "\")
Call MkDir(strNewDirectory & "\" & myName & "\" & subfldr1 & "\")
Call MkDir(strNewDirectory & "\" & myName & "\" & subfldr2 & "\")
Next
objExcel.Displayalerts = True
objexcel.Quit
wscript.quit
Function MkDir(strPath)
Dim strParentPath, objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
strParentPath = objFSO.GetParentFolderName(strPath)
If Not objFSO.FolderExists(strParentPath) Then MkDir strParentPath
If Not objFSO.FolderExists(strPath) Then objFSO.CreateFolder strPath
On Error Goto 0
MakeDir = objFSO.FolderExists(strPath)
End Function
SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
OK but how do I do the rest?
SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
I want to keep the script as it is but with one change - I want it to add a file called names.xls to the student folder once the Students folder is created and a shortcut created on the desktop to that folder. I also want it to create a text file named "instructions" with the following text (in that Student Folder) - "Please add your list of names to the Excel file called names in this folder".
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER