Trying to create new workbook (in .xlsm format) using VBA code

Question

I am trying to create multiple workbooks using the template of an existing workbook. The existing workbook is saved as .xlsm. When I try to create the new workbooks it is giving me an error. But after runing the code i have a pop up message asking if i want "to continue saving as a macro-free workbook"

If I click No, I have an error saying: Error: Run Time error '1004'. VB projects and XLM sheets cannot be saved in a macro-free workbook.

If I click Yes, I have an error saying: Error: This extension can not be used with the selected file type. I know this is because I have given the extension as .xlsm for the new workbooks and will need to change it to .xlsx if I want it to be saved as macro-free workbook.

Sub vba_create_workbook()
    
    Workbooks.Add Template:="Folder Path\File Name.xlsm"
    ActiveWorkbook.SaveAs "Folder Path\File Name.xlsm"
    
    Workbooks.Add Template:="Folder Path\File Name.xlsm"
    ActiveWorkbook.SaveAs "Folder Path\File Name.xlsm"
  
End Sub

Is there any way that the new files created can be directly saved as macro-enabled workbooks i.e (.xlsm)?

Does this answer your question? [Add a workbook from a template and change its name](https://stackoverflow.com/questions/69810642/add-a-workbook-from-a-template-and-change-its-name) — Greenonline, Dec 09 '22 at 10:19

score 0 · Answer 1 · answered Dec 09 '22 at 12:41

Create New Workbook From Template

Utilization

Sub RefNewTemplateTEST()
    
    Const SRC_FILE_PATH As String = "Folder Path\Source File Name.xlsm"
    Const DST_FILE_PATH As String = "Folder Path\Destination File Name.xlsm"
    
    Dim dwb As Workbook: Set dwb = RefNewTemplate(SRC_FILE_PATH, DST_FILE_PATH)
    
    If dwb Is Nothing Then Exit Sub
    
    ' Continue using dwb.
    
    MsgBox "Created '" & dwb.Name & "' from template.", vbInformation
    
End Sub

The Function

Function RefNewTemplate( _
    TemplatePath As String, _
    DestinationPath As String) _
As Workbook
    Const PROC_TITLE As String = "Reference New Workbook From Template"
    
    If StrComp(TemplatePath, DestinationPath, vbTextCompare) = 0 Then
        MsgBox "The Template and Destination paths are the same.", _
            vbCritical, PROC_TITLE
        Exit Function
    End If
    
    Dim dwb As Workbook, ErrNum As Long
    Dim ErrDescription As String, MsgString As String
    
    On Error Resume Next
        Set dwb = Workbooks.Add(Template:=TemplatePath)
        ErrNum = Err.Number
        ErrDescription = Err.Description
    On Error GoTo 0
    
    If ErrNum <> 0 Then
        Select Case ErrDescription
            Case "Method 'Add' of object 'Workbooks' failed"
                MsgString = "The template is already open."
            Case "Sorry, Excel can't open two workbooks with " _
                    & "the same name at the same time."
                MsgString = "A file with the same name as the template is open."
            Case Else
        End Select
        MsgBox "Run-time error '" & ErrNum & "':" & vbLf & vbLf _
            & ErrDescription & IIf(Len(MsgString) > 0, vbLf & vbLf, "") _
            & MsgString, vbCritical, PROC_TITLE
        Exit Function
    End If
        
    Application.DisplayAlerts = False ' overwrite without confirmation
        On Error Resume Next
            dwb.SaveAs DestinationPath, xlOpenXMLWorkbookMacroEnabled
            ErrNum = Err.Number
            ErrDescription = Err.Description
        On Error GoTo 0
    Application.DisplayAlerts = True
     
    If ErrNum <> 0 Then
        dwb.Close SaveChanges:=False
        MsgBox "Run-time error '" & ErrNum & "':" & vbLf & vbLf _
            & ErrDescription, vbCritical
        Exit Function
    End If
  
    Set RefNewTemplate = dwb
  
End Function

Trying to create new workbook (in .xlsm format) using VBA code

1 Answers1

Create New Workbook From Template