' 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