Solved

script issue

Posted on 2008-11-02
5
248 Views
Last Modified: 2010-04-24
Sems to be a problem with this.  I have FirstName(Cell A1) and LastName (Cell B1) and then list the names underneath but am getting a double dash for the first folder and it is only listing the next name then ignoring the rest?
Set objFSO = CreateObject("Scripting.FileSystemObject")

Set objShell = CreateObject("WScript.Shell")

strMyDocs = objShell.ExpandEnvironmentStrings("%USERPROFILE%") & "\My Documents"

strShortcutPath = "C:\1234.vbs"

 

'Create TFP folder

If objFSO.FolderExists(strMyDocs & "\TFP") = False Then objFSO.CreateFolder strMyDocs & "\TFP"

 

'Create Names.xls

If objFSO.FileExists(strMyDocs & "\TFP\names.xls") = False Then

	Set objExcel = CreateObject("Excel.Application")

	objExcel.Visible = True

	intSheetsInNewWB = objExcel.SheetsInNewWorkbook

	objExcel.SheetsInNewWorkbook = 1

	Set objWB = objExcel.Workbooks.Add

	objExcel.SheetsInNewWorkbook = intSheetsInNewWB

	Set objSheet = objWB.Sheets(1)

	objSheet.Rows("1:1").Font.Bold = True

	objSheet.Cells(1, "A") = "FirstName"

	objSheet.Cells(1, "B") = "LastName"

	objWB.SaveAs strMyDocs & "\TFP\names.xls"

End If

 

'Create Instructions.txt

If objFSO.FileExists(strMyDocs & "\TFP\Instructions.txt") = False Then

	Set objFile = objFSO.CreateTextFile(strMyDocs & "\TFP\Instructions.txt", True)

	objFile.Write "Please add your names to the Excel file called ""names"" and then click save and close the file.  Then click on the Create Folders Icon."

	objFile.Close

	Set objFile = Nothing

	objShell.Run "notepad """ & strMyDocs & "\TFP\Instructions.txt" & """", 1, False

End If

 

'Create Create Folders.lnk

If objFSO.FileExists(strMyDocs & "\TFP\Create Folders.lnk") = False Then

	' There may be a truncation issue with the shorcut path: See http://support.microsoft.com/kb/263324

	Set objShortcut = objShell.CreateShortcut(strMyDocs & "\TFP\Create Folders.lnk")

	objShortcut.TargetPath = strShortcutPath

	objShortcut.Save

	Set objShortcut = Nothing

End If

objShell.Run "explorer.exe /n, """ & strMyDocs & "\TFP""", 1, False

MsgBox "Done"

Open in new window

0
Comment
Question by:Dier02
  • 2
  • 2
5 Comments
 
LVL 19

Assisted Solution

by:weellio
weellio earned 50 total points
ID: 22863406
maybe i am misunderstanding,. what is the script not doing?
when first run it opens excel and instructions and creates a folder.
on the second run it just opens explorer again and says done.
everything in the script seems to be working.
0
 
LVL 65

Accepted Solution

by:
RobSampson earned 450 total points
ID: 22864622
Hi, I believe you have posted the wrong script.

I think you need to post the code from the VBS file at
strShortcutPath = "C:\1234.vbs"

That would be the script that actually creates the folders.....

Regards,

Rob.
0
 

Author Comment

by:Dier02
ID: 22864893
Sorry, you are correct Rob, as posted below.
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? ", "Folder name", "add subfolder name here")        'folder1

subfldr2 = inputbox("What is the second foldername? If you add nothing a folder will not be created", "Folder name", "")               'folder2

mynames = strUserProfile & "\My Documents\names.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 

Open in new window

0
 

Author Closing Comment

by:Dier02
ID: 31512539
Thanks guys.
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 22871658
Hi, your code works fine for me, although I did start my names in the XLS on row 5, because of this line:
For Each cell In ws.Range("A5:A" & lastrow)

If you want it to pick names starting from row 2, change that line to this:
For Each cell In ws.Range("A2:A" & lastrow)

Also, I have added a condition to not make any folders if the name on a row is blank.

Regards,

Rob.
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? ", "Folder name", "add subfolder name here")        'folder1

subfldr2 = inputbox("What is the second foldername? If you add nothing a folder will not be created", "Folder name", "")               'folder2

mynames = strUserProfile & "\My Documents\names.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)

    If Trim(cell.Value) <> "" Then

	    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 & "\")

	End If

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

Open in new window

0

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
delete a folder ever 5 minutes 6 60
Excel .....ActiveWorkbook.SaveAs 12 45
Pass through dll 2 62
auto script to stop bitdefender to scan my external drives 6 42
Unlike scripting languages such as C# where a semi-colon is used to indicate the end of a command, Microsoft's VBScript language relies on line breaks to determine when a command begins and ends. As you can imagine, this quickly results in messy cod…
This is pretty cool.  The purpose of this VB Script is to help you document where JAR (Java ARchive) files and specifically java class files are located so that you can address issues seen with a client or that you can speak intelligently with a dev…
This Micro Tutorial will teach you how to censor certain areas of your screen. The example in this video will show a little boy's face being blurred. This will be demonstrated using Adobe Premiere Pro CS6.
Internet Business Fax to Email Made Easy - With eFax Corporate (http://www.enterprise.efax.com), you'll receive a dedicated online fax number, which is used the same way as a typical analog fax number. You'll receive secure faxes in your email, fr…

911 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

22 Experts available now in Live!

Get 1:1 Help Now