' ExcelSpreadsheets-AddingCopyingRenamingSheets.vbs ' ' Description: ' This example script demonstrates how to add, rename and ' copy an Excel worksheet. This script also demonstrates ' one way to see whether a sheet already exists with the ' specified name, which is needed because trying to rename ' a sheet to an existing sheet's name causes an error. Dim objExcel Set objExcel = CreateObject("Excel.Application") objExcel.Visible = True Dim strWorkBookPath strWorkBookPath = "C:\temp\MyFile.xls" '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Sub Main() Dim objWb, strErrors ' Attempt to open the workbook by calling OpenWorkbook function defined ' within this script: If Not OpenWorkbook(strWorkBookPath, objWb, strErrors) Then crt.Dialog.MessageBox strErrors Exit Sub End If ' Get a reference to an existing sheet in the workbook Dim objWs strExistingSheetName = "Sheet1" If SheetExists(objWb, strExistingSheetName) Then Set objWs = objWb.Sheets(strExistingSheetName) End If ' -------------------------------------------------------------------- ' Renaming a Sheet ' -------------------------------------------------------------------- ' Rename "Sheet1" to a different name, based on today's date: ' First: Create a variable hodling the new name we wish to apply to ' the existing sheet. strNewSheetName = Replace(Date, "/", "-") ' Next: Check to see if that sheet already exists... if it does, simply ' display a message and activate that sheet. If SheetExists(objWb, strNewSheetName) Then crt.Dialog.MessageBox "A sheet named """ & _ strNewSheetName & """ already exists. Activating it now." Set objWs = objWb.Sheets(strNewSheetName) objWs.Activate Else ' If the new name doesn't already exist as a sheet, then go ' ahead with the rename operation: objWs.Name = strNewSheetName objWs.Activate crt.Dialog.MessageBox "The sheet formerly known as """ & _ strExistingSheetName & """ has been renamed to """ & _ strNewSheetName & """." End If ' -------------------------------------------------------------------- ' Copying an existing sheet (and renaming the new sheet) ' -------------------------------------------------------------------- ' Copy "Sheet2" to a new sheet named "Sheet2 - Copy", placing the new ' sheet as the first sheet in the book ' First: Make sure the sheet we're about to copy actually exists: If Not SheetExists(objWb, "Sheet2") Then crt.Dialog.MessageBox "Couldn't copy ""Sheet2"": It doesn't exist." Exit Sub End If ' Then, perform the copy operation. This is done by telling the sheet ' to copy itself to the location before the first sheet in the workbook's ' existing collection of sheets. objWb.Sheets("Sheet2").Copy objWb.Sheets(1) ' Because we specified *where* the new sheet should be placed, we know ' exactly where to get a reference to the new (copy of existing) sheet. ' Rename it to "Sheet 2 - Copy", as long as that name doesn't already ' exist within the sheet: strNewSheetName = "Sheet 2 - Copy" Set objNewWs = objWb.Sheets(1) If SheetExists(objWb, strNewSheetName) Then crt.Dialog.MessageBox "Unable to name new sheet to """ & _ strNewSheetName & """: A sheet with that name already exists." Exit Sub End If ' Now that we know a sheet doesn't already exist by that name, we ' can actually perform the rename: objNewWs.Name = strNewSheetName ' Make sure the new sheet is the active sheet. objNewWs.Activate crt.Dialog.MessageBox """Sheet2"" was copied to """ & strNewSheetName & _ """, which is now the active sheet." ' Prompt the user if changes to the workbook should be saved: If crt.Dialog.MessageBox(_ "Save Changes to workbook?", _ "Confirm Save", _ vbYesNo) <> vbYes Then objWb.Close False Else objWb.Close True End If ' Now, close the Excel application itself. objExcel.Quit End Sub '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Function OpenWorkbook(strWkBkPath, ByRef objWb, ByRef strErrors) ' Returns True if workbook was found to exist and was successfully opened. ' Returns False otherwise. ' ' Requires 'objExcel' global variable to already have been initialized via ' CreateObject("Excel.Application") ' ' strWkBkPath: [In] String representing the full path to the workbook .xls file ' to open. ' ' objWb: [Out] Reference to Excel Workbook object. This will be Nothing ' if the workbook .xls file specified in the strWkWBkPath couldn't ' be loaded. ' ' strErrors: [Out] Used only if there were errors encountered when attempting ' to open the Excel workbook .xls file specified in strWkBkPath. On Error Resume Next Set wb = objExcel.Workbooks.Open(strWkBkPath) nError = Err.Number strErr = Err.Description On Error Goto 0 If nError <> 0 Then strErrors = "Error opening workbook file: " & strWkBkPath & _ vbcrlf & vbcrlf & strErr Set objWb = Nothing Exit Function End If ' Set the reference to the [Out] param objWb: Set objWb = wb ' Set the return value of this function: OpenWorkbook = True End Function '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Function SheetExists(objWorkbook, strSheetname) ' In this "trick", we ask the workbook to provide us ' with a reference to a sheet by name. If the sheet ' doesn't exist, we simply handle the error and use ' the error as a way of determining if the named sheet ' already exists or not. ' Start off assuming the sheet exists: bExists = True ' Now, ask the workbook to provide a reference to the ' named sheet (passed into this function as 'strSheetname'): On Error Resume Next set ws = objWorkbook.Sheets(strSheetName) nError = Err.Number strErr = Err.Description On Error Goto 0 ' If there was an error, it means the sheet doesn't exist: If nError <> 0 Then bExists = False ' Set the return value of our function: SheetExists = bExists End Function