• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 5363
  • Last Modified:

Create a submit button in Word that will save the file and send an email

I have the current code that does the email part just fine:
Private Sub CommandButton1_Click()

Dim bStarted As Boolean
Dim oOutlookApp As Outlook.Application
Dim oItem As Outlook.MailItem

On Error Resume Next

If Len(ActiveDocument.Path) = 0 Then
    MsgBox "Document needs to be saved first"
    Exit Sub
End If

Set oOutlookApp = GetObject(, "Outlook.Application")
If Err <> 0 Then
    Set oOutlookApp = CreateObject("Outlook.Application")
    bStarted = True
End If

Set oItem = oOutlookApp.CreateItem(olMailItem)

With oItem
    .To = "emailaddress@email.com"
    .Subject = "Survey"
    'Add the document as an attachment, you can use the .displayname property
    'to set the description that's used in the message
    .Attachments.Add Source:=ActiveDocument.FullName, Type:=olByValue, _
      DisplayName:="Document as attachment"
    .Send
End With

If bStarted Then
    oOutlookApp.Quit
End If

Set oItem = Nothing
Set oOutlookApp = Nothing


End Sub

However, I would like the submit button to  save first and then email. I don't want to have to click save or do any short key. I would like for a user to just fill out the form and click one button (the submit button) and it will do everything else (save and email).

I would like to modify the code above to add the save portion. Thank you in advance!
0
ironman05
Asked:
ironman05
  • 2
2 Solutions
 
fhillyer1Commented:
here you go
Private Sub CommandButton1_Click()

Dim bStarted As Boolean
Dim oOutlookApp As Outlook.Application
Dim oItem As Outlook.MailItem

On Error Resume Next

If Len(ActiveDocument.Path) = 0 Then
    ActiveDocument.SaveAs FileName:="YOURFILENAME.doc"
End If

Set oOutlookApp = GetObject(, "Outlook.Application")
If Err <> 0 Then
    Set oOutlookApp = CreateObject("Outlook.Application")
    bStarted = True
End If

Set oItem = oOutlookApp.CreateItem(olMailItem)

With oItem
    .To = "emailaddress@email.com"
    .Subject = "Survey"
    'Add the document as an attachment, you can use the .displayname property
    'to set the description that's used in the message
    .Attachments.Add Source:=ActiveDocument.FullName, Type:=olByValue, _
      DisplayName:="Document as attachment"
    .Send
End With

If bStarted Then
    oOutlookApp.Quit
End If

Set oItem = Nothing
Set oOutlookApp = Nothing


End Sub

Open in new window

0
 
GrahamSkanCommented:
I suggest that you test the .Saved property. That way any modifications made after a user has saved the document won't be lost.

If Len(ActiveDocument.Path) = 0 Then
    ActiveDocument.SaveAs FileName:="YOURFILENAME.doc"
else
    if not  ActiveDocument.Saved then
        ActiveDocument.Save
    end if     
End If

Open in new window

0
 
ironman05Author Commented:
Sorry I was not able to try this out since I got swamped as soon as I posted this question. I'll test this out tomorrow. Thank you for your quick responses!
0
 
ironman05Author Commented:
Thanks for the info
0

Featured Post

New feature and membership benefit!

New feature! Upgrade and increase expert visibility of your issues with Priority Questions.

  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now