Command button and VBA Assistance

[Weefatbob]

Hi

Newbie to word vba, have some excel vba experience but not an expert. I have developed a form, which is a basic active x form, only to be used during this virus. It's saved as a Word Macro enabled template. The command button on the form saves it and emails it as an attachment, which works great, see below, however the issue I have is that this saves the master form, which is saved on our network, which for Data Protection purposes, the business does not want to happen. I guess the question I have is how do I edit the code below, to in my thoughts, a save as before sending or clear down of the 2nd column of the table when closing...hope this makes sense.




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

Doc.Save



With EmailItem

.Subject = "ENTER SUBJECT LINE HERE"

.Body = "ENTER MESSAGE HERE" '& vbCrLf & _

'"BODY SECND LINE" & vbCrLf & _

'"BODY THIRD LINE"

.To = "ENTER RECIPIENT EMAIL HERE"

'.CC = "ENTER A CC EMAIL ADDRESS AND REMOVE COMMENT OUT TO MAKE LIVE"

Importance = olImportanceHigh

.Attachments.Add Doc.FullName

.Send

End With





Application.ScreenUpdating = False



Thanks in advance

[gmayor]

There are a couple of issues that need attention in your code, but for the main part, the document you have created from your template can be saved as a temporary file, attached to the message and then deleted e.g. as follows. Personally I would use the code at Test if Outlook is open and open Outlook with VBA to open/start Outlook, but this will work with some minor changes.

Private Sub CommandButton1_Click()
'Graham Mayor - https://www.gmayor.com - Last updated - 27 Apr 2020
Dim OL As Object
Dim olInsp As Object
Dim EmailItem As Object
Dim Doc As Document
Dim wdDoc As Document
Dim oRng As Range
Dim strPath As String
    strPath = Environ("TEMP") & "\Filename.docx" 'change name as required

    Application.ScreenUpdating = False
    Set OL = CreateObject("Outlook.Application")
    Set EmailItem = OL.CreateItem(0)
    Set Doc = ActiveDocument
    Doc.SaveAs2 FileName:=strPath, FileFormat:=12, AddToRecentFiles:=False

    With EmailItem
        .Subject = "ENTER SUBJECT LINE HERE"
        .To = "ENTER RECIPIENT EMAIL HERE"
        '.CC = "ENTER A CC EMAIL ADDRESS AND REMOVE COMMENT OUT TO MAKE LIVE"
        .Importance = 2

        Set olInsp = .GetInspector
        Set wdDoc = olInsp.WordEditor
        Set oRng = wdDoc.Range
        oRng.Collapse 1
        .Display 'This line is required
        oRng.Text = "ENTER MESSAGE HERE"    '& vbCrLf & _
                                            '"BODY SECND LINE" & vbCrLf & _
                                            '"BODY THIRD LINE"
        .Attachments.Add strPath
        .Send
    End With
    Doc.Close 0
    Kill strPath
    Application.ScreenUpdating = True
    Set OL = Nothing
    Set EmailItem = Nothing
    Set olInsp = Nothing
    Set wdDoc = Nothing
    Set oRng = Nothing
End Sub