VBScript add sheets to workbook loop

I have the following code:

What I can't figure out is how to add sheets to the oNewXLS starting with sheet 2 based on the sheetCount with the generated sheet name. I have gotten this code to work only with a workbook that has enough pre-existing sheets for each oFile found in oFiles. I need this workbook to be dynamic though.  

Side question: When I create the sheet name, how do I shave the .tsv characters from it. I still want up to the "_".



 
'declare variables
Dim oNewXLS, oTSV, oExcel, oFSO4, oFolder, oFile, oFiles, sheetCount

'define variables 
Set oExcel = CreateObject("Excel.Application") 
Set oFSO4 = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO4.GetFolder(DestDir) 
Set oFiles = oFolder.Files
'Set oNewXLS = oExcel.Workbooks.Open(strNewXLS, False, True)
Set oNewXLS = oExcel.Workbooks.Open(strNewXLS, False, False) 
sheetCount = 2

'excel options
oExcel.DisplayAlerts = 0
oExcel.Visible = True 
'oExcel.Visible = False

'////////////loop through .tsv and add contents to worksheets in NewXLS////////////////////////
For Each oFile In oFiles
	If Right(oFile.Name, 4) = ".tsv" Then
				Set oTSV = oExcel.Workbooks.Open(DestDir& oFile.Name, False, True)
		oTSV.Sheets(1).Cells.Copy oNewXLS.Sheets(sheetCount).Range("A1")
		oTSV.Close False 
		oNewXLS.Sheets(sheetCount).Name = Right(oFile.Name, (Len(oFile.Name) - (InStrRev(oFile.Name, "_") ))) 
		sheetCount = sheetCount + 1
	End IF
Next

oExcel.Run "fmatWBOOK"
oNewXLS.SaveAs strNewXLS
oNewXLS.Close
oExcel.Quit


'clear variables
Set oTSV = nothing
Set oExcel = nothing
set oFSO4 = nothing
set oFolder = nothing
set oFile = nothing
Set oFiles = nothing
Set sheetCount = nothing
Set oNewXLS = nothing

Open in new window

brukillaAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Bill PrewCommented:
I can't really understand the first part of your question, but you can add a new sheet to the end by using something like this:

oNewXLS.Sheets.Add After:=oNewXLS.Sheets(Sheets.Count)

For the second part though, I think you are looking for this:

oNewXLS.Sheets(sheetCount).Name = Left(oFile.Name, InStr(oFile.Name, "_")-1)

That would give you the filename up to the first "_", not including the "_".  So if the file name was "test_file.tsv" this would name the sheet "test".

~bp
0
brukillaAuthor Commented:
Fir the file name to sheet name, I was looking for the opposite:
test_file.txt to file as the sheet name. I accomplished this with:

sheetName = Left(oFile.Name, Len(oFile.Name) - 4)
sheetName = Right(sheetName, (Len(sheetName) - (InStrRev(sheetName, "_"))))

I am still unable to add a sheet. I get an 'Expected Statement' error at 'Active'.
 To clear up any confusion, I want the added sheet to possess the 'sheetName' that was created.

The 'sheetCount' starts at 2 because the first sheet is part of the template.
0
brukillaAuthor Commented:
I meant 'After' instead of 'Active' with regard to the 'Expected Statement' error.
0
Cloud Class® Course: Microsoft Windows 7 Basic

This introductory course to Windows 7 environment will teach you about working with the Windows operating system. You will learn about basic functions including start menu; the desktop; managing files, folders, and libraries.

Bill PrewCommented:
Where are the following variables set, I don't see it happening in the script?

DestDir
strNewXLS

~bp
0
RobSampsonCommented:
Hi, try this. I haven't tested it, but I've rearranged the code slightly.

You can access the sheet count in real time oNewXLS.Sheets.Count, so I use that instead.

When iterating through the files, I get the file name first, into strSheetName. Then I check through the existing sheets to see if there is one called that. If not, create it using the Sheets.Add method, inserting it AFTER the last sheet, so it's at the end.

Then we rename the new last sheet to the strSheetName.

Finally, we open the TSV and copy the data to the last sheet.

Regards,

Rob.
'declare variables 
Dim oNewXLS, oTSV, oExcel, oFSO4, oFolder, oFile, oFiles, oSheet, strSheetName
 
'define variables  
Set oExcel = CreateObject("Excel.Application")  
Set oFSO4 = CreateObject("Scripting.FileSystemObject") 
Set oFolder = oFSO4.GetFolder(DestDir)  
Set oFiles = oFolder.Files 
'Set oNewXLS = oExcel.Workbooks.Open(strNewXLS, False, True) 
Set oNewXLS = oExcel.Workbooks.Open(strNewXLS, False, False)  
 
'excel options 
oExcel.DisplayAlerts = 0 
oExcel.Visible = True  
'oExcel.Visible = False 
 
'////////////loop through .tsv and add contents to worksheets in NewXLS//////////////////////// 
For Each oFile In oFiles 
        If Right(oFile.Name, 4) = ".tsv" Then 
                strSheetName = Left(oFile.Name, Len(oFile.Name) - InStrRev(oFile.Name, "_"))
                boolSheetExists = False
                For Each oSheet In oNewXLS.Sheets
                	If LCase(oSheet.Name) = LCase(strSheetName) Then boolSheetExists = True
                Next
                If boolSheetExists = False Then oNewXLS.Sheets.Add , oNewXLS.Sheets(oNewXLS.Sheets.Count)
                oNewXLS.Sheets(oNewXLS.Sheets.Count).Name = strSheetName
                Set oTSV = oExcel.Workbooks.Open(DestDir& oFile.Name, False, True) 
                oTSV.Sheets(1).Cells.Copy oNewXLS.Sheets(oNewXLS.Sheets(strSheetName)).Range("A1") 
                oTSV.Close False
        End If 
Next 
 
oExcel.Run "fmatWBOOK" 
oNewXLS.SaveAs strNewXLS 
oNewXLS.Close 
oExcel.Quit 
 
 
'clear variables 
Set oTSV = nothing 
Set oExcel = nothing 
set oFSO4 = nothing 
set oFolder = nothing 
set oFile = nothing 
Set oFiles = nothing 
Set oNewXLS = Nothing

Open in new window

0
brukillaAuthor Commented:
I figured it out:

Set addSheet = oNewXLS.Sheets.Add( , oNewXLS.WorkSheets(oNewXLS.WorkSheets.Count))
0
RobSampsonCommented:
Hi, that was part of my solution as well, and you might also want to use my section that checks for the existence of the sheet already, just in case.

Rob.
0
RobSampsonCommented:
Did you also fix the sheet name up to the "_"?  You needed to use Left, not Right....

                strSheetName = Left(oFile.Name, Len(oFile.Name) - InStrRev(oFile.Name, "_"))

Regards,

Rob.
0
brukillaAuthor Commented:
For some reason, neither comment before my solution was visible to me when I posted and accepted my solution. So, I really did get the answers through research.

Rob - I would have really liked for the code you shared to have been visible to me earlier.

I am posting my 'final' code below. Since I really don't know how to do error checking, I was hoping some suggestions could be made.
Option Explicit

'///////////////User Input/////////////////////////////////////////////////////////////////////


'declare variables
Dim Prognym, CurDir 

'Get current directory
CurDir = left(WScript.ScriptFullName,(Len(WScript.ScriptFullName))-(len(WScript.ScriptName)))

'Get program loc and acronym to verify directory existence
Prognym = InputBox("Enter Program Location and Acronym " & vbcrlf & vbcrlf & _
		 	"Follow this Example: CNLA_PROGRAM" & vbcrlf & vbcrlf & _
			"If you leave blank or cancel, the script will exit.")

'cancel if blank entry
If Prognym = "" Then WScript.Quit


'///////////////Verify Directory Existence/////////////////////////////////////////////////////


'declare variables
Dim DestDir, oFSO1

'define variables
DestDir = CurDir&prognym&"\"
Set oFSO1 = CreateObject("Scripting.FileSystemObject")

'check for directory existence and quit script if needed, echo to user
If Not oFSO1.FolderExists(DestDir) Then
	WScript.Echo "DestDir does not exist!! Check your spelling"
	WScript.Quit
End If

'check for directory existence and echo to user
If oFSO1.FolderExists(DestDir) Then
	'WScript.Echo "Folder Exists - Click OK to continue"
End If

'clear variables
Set oFSO1 = nothing


'/////////////Copy Template File to Destination Directory/////////////////////////////////////////


'declare variables
Dim oFSO2, strCurTemplateXLS, strDestTemplateXLS 

'define variables
strCurTemplateXLS = CurDir& "Prog_List_Template.xls"
strDestTemplateXLS = DestDir& "Prog_List_Template.xls"
Set oFSO2 = CreateObject("Scripting.FileSystemObject")

'just checking for template file existence in current directory, script quits if true
If Not oFSO2.FileExists(strCurTemplateXLS) Then
	WScript.Echo "The template file is missing. " & vbcrlf & vbcrlf & _
	     "Place the template file in " & CurDir & vbcrlf & _
	     "and re-run VBScript_Installed_Progs_Excel_Transfer.vbs" & vbcrlf & vbcrlf & _
         "The template file must be named Prog_List_Template.xls" 
	WScript.Quit
End If

'just checking to see if the template file exists in the destination directory already, 
'deletes template file in destination directory if true, which allows copying new template to destination
If oFSO2.FileExists(strDestTemplateXLS) Then
	oFSO2.DeleteFile(strDestTemplateXLS)
	'WScript.Echo "Template file existed in DestDir and was deleted"
End If 

'copy template file from current directory to destination directory
If oFSO2.FileExists(strCurTemplateXLS) Then
	oFSO2.CopyFile strCurTemplateXLS, DestDir
	'WScript.Echo "Template file exists in CurDir and copied to " & DestDir 
End If

'clear variables
Set oFSO2 = nothing


'/////////////Keep only one .old XLS and Rename Template///////////////////////////////////////


'declare variables
Dim oFSO3, strExistingXLS, strExistingOldXLS, strExistingXLS2Old, strNewXLS

'define variables
Set oFSO3 = CreateObject("Scripting.FileSystemObject")
'Set oFSO4 = CreateObject("Scripting.FileSystemObject")
'Set oFolder1 = oFSO3.GetFolder(DestDir)
'Set oFiles = oFolder1.Files
strNewXLS = DestDir&Prognym& "_Installed_Progs.xls"
strExistingXLS = DestDir&Prognym& "_Installed_Progs.xls"
strExistingOldXLS = DestDir&Prognym& "_Installed_Progs.xls.old"
strExistingXLS2Old = DestDir&Prognym& "_Installed_Progs.xls.old"

'check for new and old, rename to destination
If oFSO3.FileExists(strExistingXLS) And oFSO3.FileExists(strExistingOldXLS) Then
	oFSO3.DeleteFile(strExistingOldXLS)
	oFSO3.MoveFile strExistingXLS, strExistingXLS2Old
	oFSO3.MoveFile strDestTemplateXLS, strNewXLS 
	'WScript.Echo "both existed"
End If 

'check for new only, rename to destination
If oFSO3.FileExists(strExistingXLS) And Not oFSO3.FileExists(strExistingOldXLS) Then
	oFSO3.MoveFile strExistingXLS, strExistingXLS2Old
	oFSO3.MoveFile strDestTemplateXLS, strNewXLS 
	'WScript.Echo "one existed"
End If 

'check for neither, rename to destination
If Not oFSO3.FileExists(strExistingXLS) And Not oFSO3.FileExists(strExistingOldXLS) Then
	oFSO3.MoveFile strDestTemplateXLS, strNewXLS 
	'WScript.Echo "not both existed"
End If 

'check for old only, rename to destination
If Not oFSO3.FileExists(strExistingXLS) And oFSO3.FileExists(strExistingOldXLS) Then
	oFSO3.MoveFile strDestTemplateXLS, strNewXLS 
	'WScript.Echo "only old existed"
End If 

'clear variables
Set oFSO3 = nothing
Set strExistingXLS = nothing
Set strExistingOldXLS = nothing
Set strExistingXLS2Old = nothing


'/////////////Open .tsv and copy to XLS on its own sheet///////////////////////////////////////


'declare variables
Dim oNewXLS, oTSV, oExcel, oFSO4, oFolder, oFile, oFiles, sheetCount, sheetName, addSheet

'define variables 
Set oExcel = CreateObject("Excel.Application") 
Set oFSO4 = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO4.GetFolder(DestDir) 
Set oFiles = oFolder.Files
'Set oNewXLS = oExcel.Workbooks.Open(strNewXLS, False, True)
Set oNewXLS = oExcel.Workbooks.Open(strNewXLS, False, False) 
sheetCount = 2

'excel options
oExcel.DisplayAlerts = 0
'oExcel.Visible = True 
oExcel.Visible = False

'////////////loop through .tsv and add contents to worksheets in NewXLS////////////////////////
For Each oFile In oFiles
	If Right(oFile.Name, 4) = ".tsv" Then
		
		'define variables
		Set oTSV = oExcel.Workbooks.Open(DestDir& oFile.Name, False, True)
		Set addSheet = oNewXLS.Sheets.Add( , oNewXLS.WorkSheets(oNewXLS.WorkSheets.Count))
		
		'perform adding sheets and naming them
		sheetName = Left(oFile.Name, Len(oFile.Name) - 4) 
		sheetName = Right(sheetName, (Len(sheetName) - (InStrRev(sheetName, "_"))))
		oTSV.Sheets(1).Cells.Copy oNewXLS.Sheets(sheetCount).Range("A1")
		oTSV.Close False 
		oNewXLS.Sheets(sheetCount).Name = sheetName
		sheetCount = sheetCount + 1
	End IF
Next

oExcel.Run "fmatWBOOK"
oNewXLS.SaveAs strNewXLS
oNewXLS.Close
oExcel.Quit


'clear variables
Set oNewXLS = nothing
Set oTSV = nothing
Set oExcel = nothing
set oFSO4 = nothing
set oFolder = nothing
set oFile = nothing
Set oFiles = nothing
Set sheetCount = nothing
Set sheetName = nothing
Set addSheet = nothing

'clear leftover variables
Set Prognym = nothing
Set CurDir = nothing
Set DestDir = nothing
Set strCurTemplateXLS = nothing
Set strDestTemplateXLS = nothing
Set strNewXLS = nothing

WScript.Echo "complete"

Open in new window

0
RobSampsonCommented:
I have added this:
If Right(CurDir, 1) <> "\" Then CurDir = CurDir & "\"

to make sure that CurDir always has a trailing slash, so the path for DestDir will always be correct.

I have added this:
If Right(Prognym, 1) = "\" Then Prognym = Left(Prognym, Len(Prognym) - 1)

just to make sure that Prognym does not have a trailing slash when entered by the user, otherwise your DestDir path may be incorrect.

I have also changed this:

oNewXLS.SaveAs strNewXLS

to this

oExcel.DisplayAlerts = False
oNewXLS.SaveAs strNewXLS
oExcel.DisplayAlerts = True


to force an overwrite of the file if it exists, just in case.

Other that that, it looks pretty good.

Just a comment on the code in general.....when creating and using objects of the same type, like the Scripting.FileSystemObject, you only need to use one object.  That is, you don't need oFSO, oFSO1, oFSO2, oFSO3, oFSO4 because they are all the same object. You only need one, and any file operations use that one. It looks like you've pieced a fair few scripts together though, so I can understand why you did that....

Regards,

Rob.
Option Explicit

'///////////////User Input/////////////////////////////////////////////////////////////////////


'declare variables
Dim Prognym, CurDir 

'Get current directory
CurDir = left(WScript.ScriptFullName,(Len(WScript.ScriptFullName))-(len(WScript.ScriptName)))
If Right(CurDir, 1) <> "\" Then CurDir = CurDir & "\"
'Get program loc and acronym to verify directory existence
Prognym = InputBox("Enter Program Location and Acronym " & vbcrlf & vbcrlf & _
		 	"Follow this Example: CNLA_PROGRAM" & vbcrlf & vbcrlf & _
			"If you leave blank or cancel, the script will exit.")

'cancel if blank entry
If Prognym = "" Then WScript.Quit
If Right(Prognym, 1) = "\" Then Prognym = Left(Prognym, Len(Prognym) - 1)
'///////////////Verify Directory Existence/////////////////////////////////////////////////////

'declare variables
Dim DestDir, oFSO1

'define variables
DestDir = CurDir&prognym&"\"
Set oFSO1 = CreateObject("Scripting.FileSystemObject")

'check for directory existence and quit script if needed, echo to user
If Not oFSO1.FolderExists(DestDir) Then
	WScript.Echo "DestDir does not exist!! Check your spelling"
	WScript.Quit
End If

'check for directory existence and echo to user
If oFSO1.FolderExists(DestDir) Then
	'WScript.Echo "Folder Exists - Click OK to continue"
End If

'clear variables
Set oFSO1 = nothing


'/////////////Copy Template File to Destination Directory/////////////////////////////////////////


'declare variables
Dim oFSO2, strCurTemplateXLS, strDestTemplateXLS 

'define variables
strCurTemplateXLS = CurDir& "Prog_List_Template.xls"
strDestTemplateXLS = DestDir& "Prog_List_Template.xls"
Set oFSO2 = CreateObject("Scripting.FileSystemObject")

'just checking for template file existence in current directory, script quits if true
If Not oFSO2.FileExists(strCurTemplateXLS) Then
	WScript.Echo "The template file is missing. " & vbcrlf & vbcrlf & _
	     "Place the template file in " & CurDir & vbcrlf & _
	     "and re-run VBScript_Installed_Progs_Excel_Transfer.vbs" & vbcrlf & vbcrlf & _
         "The template file must be named Prog_List_Template.xls" 
	WScript.Quit
End If

'just checking to see if the template file exists in the destination directory already, 
'deletes template file in destination directory if true, which allows copying new template to destination
If oFSO2.FileExists(strDestTemplateXLS) Then
	oFSO2.DeleteFile(strDestTemplateXLS)
	'WScript.Echo "Template file existed in DestDir and was deleted"
End If 

'copy template file from current directory to destination directory
If oFSO2.FileExists(strCurTemplateXLS) Then
	oFSO2.CopyFile strCurTemplateXLS, DestDir
	'WScript.Echo "Template file exists in CurDir and copied to " & DestDir 
End If

'clear variables
Set oFSO2 = nothing


'/////////////Keep only one .old XLS and Rename Template///////////////////////////////////////


'declare variables
Dim oFSO3, strExistingXLS, strExistingOldXLS, strExistingXLS2Old, strNewXLS

'define variables
Set oFSO3 = CreateObject("Scripting.FileSystemObject")
'Set oFSO4 = CreateObject("Scripting.FileSystemObject")
'Set oFolder1 = oFSO3.GetFolder(DestDir)
'Set oFiles = oFolder1.Files
strNewXLS = DestDir&Prognym& "_Installed_Progs.xls"
strExistingXLS = DestDir&Prognym& "_Installed_Progs.xls"
strExistingOldXLS = DestDir&Prognym& "_Installed_Progs.xls.old"
strExistingXLS2Old = DestDir&Prognym& "_Installed_Progs.xls.old"

'check for new and old, rename to destination
If oFSO3.FileExists(strExistingXLS) And oFSO3.FileExists(strExistingOldXLS) Then
	oFSO3.DeleteFile(strExistingOldXLS)
	oFSO3.MoveFile strExistingXLS, strExistingXLS2Old
	oFSO3.MoveFile strDestTemplateXLS, strNewXLS 
	'WScript.Echo "both existed"
End If 

'check for new only, rename to destination
If oFSO3.FileExists(strExistingXLS) And Not oFSO3.FileExists(strExistingOldXLS) Then
	oFSO3.MoveFile strExistingXLS, strExistingXLS2Old
	oFSO3.MoveFile strDestTemplateXLS, strNewXLS 
	'WScript.Echo "one existed"
End If 

'check for neither, rename to destination
If Not oFSO3.FileExists(strExistingXLS) And Not oFSO3.FileExists(strExistingOldXLS) Then
	oFSO3.MoveFile strDestTemplateXLS, strNewXLS 
	'WScript.Echo "not both existed"
End If 

'check for old only, rename to destination
If Not oFSO3.FileExists(strExistingXLS) And oFSO3.FileExists(strExistingOldXLS) Then
	oFSO3.MoveFile strDestTemplateXLS, strNewXLS 
	'WScript.Echo "only old existed"
End If 

'clear variables
Set oFSO3 = nothing
Set strExistingXLS = nothing
Set strExistingOldXLS = nothing
Set strExistingXLS2Old = nothing


'/////////////Open .tsv and copy to XLS on its own sheet///////////////////////////////////////


'declare variables
Dim oNewXLS, oTSV, oExcel, oFSO4, oFolder, oFile, oFiles, sheetCount, sheetName, addSheet

'define variables 
Set oExcel = CreateObject("Excel.Application") 
Set oFSO4 = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO4.GetFolder(DestDir) 
Set oFiles = oFolder.Files
'Set oNewXLS = oExcel.Workbooks.Open(strNewXLS, False, True)
Set oNewXLS = oExcel.Workbooks.Open(strNewXLS, False, False) 
sheetCount = 2

'excel options
oExcel.DisplayAlerts = 0
'oExcel.Visible = True 
oExcel.Visible = False

'////////////loop through .tsv and add contents to worksheets in NewXLS////////////////////////
For Each oFile In oFiles
	If Right(oFile.Name, 4) = ".tsv" Then
		
		'define variables
		Set oTSV = oExcel.Workbooks.Open(DestDir& oFile.Name, False, True)
		Set addSheet = oNewXLS.Sheets.Add( , oNewXLS.WorkSheets(oNewXLS.WorkSheets.Count))
		
		'perform adding sheets and naming them
		sheetName = Left(oFile.Name, Len(oFile.Name) - 4) 
		sheetName = Right(sheetName, (Len(sheetName) - (InStrRev(sheetName, "_"))))
		oTSV.Sheets(1).Cells.Copy oNewXLS.Sheets(sheetCount).Range("A1")
		oTSV.Close False 
		oNewXLS.Sheets(sheetCount).Name = sheetName
		sheetCount = sheetCount + 1
	End IF
Next

oExcel.Run "fmatWBOOK"
oExcel.DisplayAlerts = False
oNewXLS.SaveAs strNewXLS
oExcel.DisplayAlerts = True
oNewXLS.Close
oExcel.Quit


'clear variables
Set oNewXLS = nothing
Set oTSV = nothing
Set oExcel = nothing
set oFSO4 = nothing
set oFolder = nothing
set oFile = nothing
Set oFiles = nothing
Set sheetCount = nothing
Set sheetName = nothing
Set addSheet = nothing

'clear leftover variables
Set Prognym = nothing
Set CurDir = nothing
Set DestDir = nothing
Set strCurTemplateXLS = nothing
Set strDestTemplateXLS = nothing
Set strNewXLS = nothing

WScript.Echo "complete"

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
brukillaAuthor Commented:
The change in code really helps me understand the code more fully. I just started VBScripting with what you see before you. Thanks for all your help so far.

Now I am trying to manage all the data created within the excel sheet with VBA. I may be asking another question in the near future. I just need to develop more code first.

Thanks again for your help and assitance.
0
RobSampsonCommented:
No problem. If you have any more questions, feel free to ask.

Rob.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Development

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.