Adding a save as macro button to a template

[nparsons75]

Hi, really hope someone can help with this.

I have a macro button that sends a document via email. I would also like the macro to save the file in a particular location with some details in the filename.

For example,

path: C:\reports\templates

filename: to include, MMR, Author, date, time,

example: MMR A.N.Other 20160108 09:10.doc

My current macro code is below.

Private Sub CommandButton1_Click()
Dim OL              As Object
Dim EmailItem       As Object
Dim Doc             As Document
 
Application.ScreenUpdating = False
Set OL = CreateObject("Outlook.Application")
Set EmailItem = OL.CreateItem(olMailItem)
Set Doc = ActiveDocument

With EmailItem
    .Subject = "Monthly Management Report"
    .Body = "Hi Brian," & vbCrLf & _
    "Please find attached our Monthly Management Report" & vbCrLf & _
    "Regards,"
    .To = "n.parsons@lur.co.uk"
    .Importance = olImportanceNormal
    .Attachments.Add Doc.FullName
    .Send
End With
 
Application.ScreenUpdating = True
 
Set Doc = Nothing
Set OL = Nothing
Set EmailItem = Nothing
End Sub

Private Sub CommandButton2_Click()
ActiveDocument.PrintOut Copies:=1
End Sub

Appreciate any help.

[gmayor]

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).

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

[nparsons75]

Thank you, you may be right. How would I do that, ribbon buttons?

[nparsons75]

Hi the code returns this error: .Attachments.Add Doc.FullName when i debug.

Any ideas?

Thanks again

[gmayor]

Does the folder C:\reports\templates\ exist? You will get an error if it doesn't.

The attached template includes a ribbon, a modified version of the code to reflect that, and includes some basic error correction. It also works!

You can edit the ribbon with the CustomUI editor - see http://gregmaxey.com/word_tip_pages/...bbon_main.html

[nparsons75]

Now that is really good, never realised you could do that?

I will have a read through it. I need to work out how to edit the button as the save location needs to be changed.

Thank you so much.

[gmayor]

The save location is in the code in the templates ModMain and in any case the default from your earlier post is created if not present.

Const strPath As String = "C:\reports\templates\"