Microsoft Office Forums - View Single Post - [Solved] Adding a save as macro button to a template

gmayor · 01-08-2016, 03:17 AM

It is easy enough to include the option to save (though you can't have a colon in the filename). Frankly I would use ribbon buttons for this in the document template rather than ActiveX buttons in the document (Menu buttons for Word 2003 and earlier).

Code:

Private Sub CommandButton1_Click()
Dim OL As Object
Dim EmailItem As Object
Dim olInsp As Object
Dim wdDoc As Document
Dim oRng As Range
Dim Doc As Document
Dim strFname As String
Const strPath As String = "C:\reports\templates\"
    Application.ScreenUpdating = False
    On Error Resume Next

    Set OL = GetObject(, "Outlook.Application")
    If Err <> 0 Then
        Set OL = CreateObject("Outlook.Application")
    End If
    Set EmailItem = OL.CreateItem(0)
    Set Doc = ActiveDocument
    strFname = strpath & "MMR "
    strFname = strFname & Doc.BuiltInDocumentProperties("Author")
    strFname = strFname & Chr(32) & Format(Date, "yyyyddmm")
    strFname = strFname & Chr(32) & Format(Time, "HHMM") & ".doc"
    Doc.SaveAs strFname
    With EmailItem
        Set olInsp = .GetInspector
        Set wdDoc = olInsp.WordEditor
        Set oRng = wdDoc.Range(0, 0)
        .Subject = "Monthly Management Report"
        oRng.Text = "Hi Brian," & vbCrLf & _
                "Please find attached our Monthly Management Report" & vbCrLf & _
                "Regards,"
        .to = "n.parsons@lur.co.uk"
        .Importance = 1
        .Attachments.Add Doc.FullName
        .Display
        .Send
    End With

    Application.ScreenUpdating = True

    Set Doc = Nothing
    Set OL = Nothing
    Set olInsp = Nothing
    Set wdDoc = Nothing
    Set oRng = Nothing
    Set EmailItem = Nothing
End Sub