VBA to Save As WorkBook xlsm

[ABabeNChrist]

Currently I’m using this piece of code when starting a new report from within the master workbook. It first opens the Save As dialog so that I can give a name to new report, then by selecting the Save button it then saves this new copy within the same ActiveWorkbook. It then also closes the master workbook without saving and leaves the new report open and ready to work on.
Is it possible to eliminate the Save As dialog from appearing, but instead use a input box to enter the new report name then Save As xlsm within same ActiveWorkbook in separate folder that is named “Saved Reports” I also would still like to have the master workbook close and new report stay open.

Code: Select all

    If Application.Dialogs(xlDialogSaveAs).Show(arg2:=xlOpenXMLWorkbookMacroEnabled) Then
        Dim WSHShell As Object
        Dim strDesktopPath As String
        Set WSHShell = CreateObject("WScript.Shell")
        ' Read desktop path using WshSpecialFolders object
        strDesktopPath = WSHShell.SpecialFolders("Desktop")
        If Not Right(strDesktopPath, 1) = "\" Then
            strDesktopPath = strDesktopPath & "\"
        End If
        With WSHShell.CreateShortcut(strDesktopPath & "\" & ActiveWorkbook.Name & ".lnk")
            ' Set shortcut object properties and save it
            .TargetPath = ActiveWorkbook.FullName
            .Save
        End With
        Set WSHShell = Nothing

    Else
        MsgBox ("You have selected cancel")
    End If

Here is my attempt of what I was trying to achieve.

Code: Select all

    Dim wbOld As Workbook    'refers to master workbook
    Dim wbNew As Workbook    'refers to new workbook
    Dim nwb As String  'refers to input box

    On Error GoTo EH

    Application.ScreenUpdating = False
    Application.EnableEvents = False

    nwb = Application.InputBox("Enter new report name", "Starting a new report", Type:=2)

    If nwb = "False" Then Exit Sub

    Set wbOld = ThisWorkbook("master.xlsm")

    With wbOld
        .SaveAs
        .FileFormat = xlOpenXMLWorkbookMacroEnabled
        .Name = nwb
        .TargetPath = "ActiveWorkbook.FullName\Saved Reports"
        .Close

    End With

    Set wbNew = ActiveWorkbook

    With wbn
        .Save
    End With

    Application.ScreenUpdating = True
    Application.EnableEvents = True

EH:     Exit Sub

[HansV]

Is Master.xlsm the active workbook when this code is run?

[ABabeNChrist]

yes

[HansV]

Code such as

Set wbOld = ThisWorkbook("master.xlsm")

and

Code: Select all

    With wbOld
        .SaveAs
        .FileFormat = xlOpenXMLWorkbookMacroEnabled
        .Name = nwb
        .TargetPath = "ActiveWorkbook.FullName\Saved Reports"

makes no sense. Moreover, once you use SaveAs, the active workbook IS the newly saved one, so there is no need to (a) close the master workbook (it is not open anymore) or (b) to save the new workbook (you just saved it!)

Try this much shortened version:

Code: Select all

    Dim nwb As String  'refers to input box

    On Error GoTo EH

    Application.EnableEvents = False

    nwb = Application.InputBox("Enter new report name", _
        "Starting a new report", Type:=2)
    If nwb = "False" Then Exit Sub
    ThisWorkbook.SaveAs Filename:=ActiveWorkbook.FullName & _
        "\Saved Reports\" & nwb, FileFormat:=xlOpenXMLWorkbookMacroEnabled

    Application.EnableEvents = True

EH:
    Exit Sub

[ABabeNChrist]

I tried your shortened version and it doesn’t seem to work correctly I receive an error. When I first run the code the input box opens, I then enter a name for new report, and then select OK. At first I noticed that nothing seemed to be happening. I then ‘ on the On Error GoTo EH , then ran code again to find where the error may be. Here is the error message I received and on what line. I checked to make sure that there was a folder named Saved Reports in same location as master.xlsm

error.JPG

Code: Select all

    ThisWorkbook.SaveAs Filename:=ActiveWorkbook.FullName & _
        "\Saved Reports\" & nwb, FileFormat:=xlOpenXMLWorkbookMacroEnabled

[HansV]

Sorry, my error. Change the lines

Code: Select all

    ThisWorkbook.SaveAs Filename:=ActiveWorkbook.FullName & _
        "\Saved Reports\" & nwb, FileFormat:=xlOpenXMLWorkbookMacroEnabled

to

Code: Select all

    ThisWorkbook.SaveAs Filename:=ActiveWorkbook.Path & _
        "\Saved Reports\" & nwb, FileFormat:=xlOpenXMLWorkbookMacroEnabled

[ABabeNChrist]

Thank you Hans
That was the golden ticket
Work great

[ABabeNChrist]

I added some finishing touches so that I could add a shortcut to my desktop when a new report is started, I believe everything in done correctly and in the right location.

Code: Select all

    Dim WSHShell As Object
    Dim MyShortcut As Object
    Dim DesktopPath As String

    If ActiveWorkbook.Name <> "HomeInspection.xlsm" Then
        MsgBox ("A new report has already been created")
        UserForm2.Hide
        UserForm6.Show
        Exit Sub

    End If

    Dim nwb As String

    On Error GoTo EH

    Application.EnableEvents = False

    nwb = Application.InputBox("Enter new report name", _
                               "Starting a new report", Type:=2)
    If nwb = "False" Then Exit Sub

    ThisWorkbook.SaveAs Filename:=ActiveWorkbook.Path & _
                                  "\Saved Reports\" & nwb, FileFormat:=xlOpenXMLWorkbookMacroEnabled

    Set WSHShell = CreateObject("WScript.Shell")
    DesktopPath = WSHShell.SpecialFolders("Desktop")

    Set MyShortcut = WSHShell.CreateShortcut(DesktopPath & "\" & _
                                             ActiveWorkbook.Name & ".lnk")

    With MyShortcut
        .TargetPath = ActiveWorkbook.FullName
        .Save

    End With
    Set WSHShell = Nothing

    MsgBox "Your new report named " & ActiveWorkbook.Name & " is now ready and a shortcut icon has been placed on your desktop."

    Application.EnableEvents = True

EH:
    Exit Sub

[HansV]

That looks good!

[ABabeNChrist]

I thank you Hans for your eagle eye and expertise

[ABabeNChrist]

As to my code in post 34157, I wanted to add a piece of code that would +1 to the existing number value on hidden sheet Client_info range E5 of HomeInspection.xlsm, before the save as is applied. This way upon starting new report the cell range of E5 that represents and invoice # it would then go to next number and so on with each and every new report. I tried using this code below after the End If and it only seems to save as without adding +1

Code: Select all

Sheets("Client_info").Range("E5") = Sheets("Client_info").Range("E5").Value + 1

[HansV]

Either post the complete code or attach a workbook, please.

[ABabeNChrist]

Here is how i inserted the code I also added workbook and sheet protection on and off

Code: Select all

Private Sub CommandButton16_Click()
    Dim WSHShell As Object
    Dim MyShortcut As Object
    Dim DesktopPath As String
    Dim strName As String
    Dim p As Integer

    If ActiveWorkbook.Name <> "HomeInspection.xlsm" Then
        MsgBox ("A new report has already been created")
        UserForm2.Hide
        UserForm6.Show
        Exit Sub

    End If

    ActiveWorkbook.Protect PassWord:="", Structure:=False, Windows:=False
    Sheets("Client_info").Unprotect
    Sheets("Client_info").Range("E5") = Sheets("Client_info").Range("E5").Value + 1
    Sheets("Client_info").Protect DrawingObjects:=False, Contents:=True, Scenarios:=True, _
                                  PassWord:="", UserInterFaceOnly:=True
    ActiveWorkbook.Protect PassWord:="", Structure:=True, Windows:=True

    Dim nwb As String
    
    On Error GoTo EH

    Application.EnableEvents = False

    nwb = Application.InputBox("Enter new report name", _
                               "Starting a new report", Type:=2)
    If nwb = "False" Then Exit Sub

    ThisWorkbook.SaveAs Filename:=ActiveWorkbook.Path & _
                                  "\Saved Reports\" & nwb, FileFormat:=xlOpenXMLWorkbookMacroEnabled

    Set WSHShell = CreateObject("WScript.Shell")
    DesktopPath = WSHShell.SpecialFolders("Desktop")

    Set MyShortcut = WSHShell.CreateShortcut(DesktopPath & "\" & _
                                             ActiveWorkbook.Name & ".lnk")

    With MyShortcut
        .TargetPath = ActiveWorkbook.FullName
        .Save

    End With
    Set WSHShell = Nothing

    strName = ActiveWorkbook.Name
    p = InStrRev(strName, ".")
    strName = Left(strName, p - 1)

    MsgBox "Your new report named " & strName & " is now ready and a shortcut icon has been placed on your desktop."

    Application.EnableEvents = True

EH:
    Exit Sub
End Sub

[HansV]

I created a new workbook, added a command button CommandButton16 to the first sheet and copied the code into its On Click event procedure. I added a sheet Client_info and saved the workbook as HomeInspection.xlsm.
When I click the command button, the value cell E5 on Client_info is incremented by 1, so the code does work. I'm not sure what you want with it though, since the new value will be in the saved report, not in HomeInspection.xlsm, so the value will be the same in all reports.

[ABabeNChrist]

What I was trying to achieve was to have the new +1 value added to HomeInspection.xlsm first then the save as for the new report, this way each new report would have different invoice #.
I just had a thought maybe I should I use a ActiveWorkbook.Save behind

Code: Select all

Sheets("Client_info").Range("E5") = Sheets("Client_info").Range("E5").Value + 1

[HansV]

Yes, if you save after increasing the number, the value will be saved in HomeInspection.xlsm.

[ABabeNChrist]

Thank you very much Hans