Sending document as Email attachment

[jeanmac]

Hello all

I've been working on code to send a document as an Outlook attachment with a
specific Email address in the CC field. I've managed to do this pretty well
with help from this site. Everything appeared to be working well, and then
all of a sudden the Email message opens with a prompt to save it. I don't
want that prompt, I just want them to be able to write their Email. Does
anyone have an idea what's gone wrong? I'm attaching a copy of my code.
Thanks for all your help.
Sub Send_As_Mail_Attachment()

' send the document as an attachment in an Outlook Email message
Dim bStarted As Boolean
Dim oOutlookApp As Outlook.Application
Dim oItem As Outlook.MailItem

On Error Resume Next

'Prompt the user to save the document
ActiveDocument.SaveAs ("")

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

'unprotect the two protected sections of the document (need to do this
before protecting all)
ActiveDocument.Unprotect Password:="equities"

'protect the whole document as read only before sending
ActiveDocument.Sections(1).ProtectedForForms = True
ActiveDocument.Sections(2).ProtectedForForms = True
ActiveDocument.Sections(3).ProtectedForForms = True
ActiveDocument.Protect Password:="equities", NoReset:=False, Type:= _
wdAllowOnlyFormFields
ActiveDocument.Save

'Get Outlook if it's running
Set oOutlookApp = GetObject(, "Outlook.Application")

'Outlook wasn't running, start it from code
If Err <> 0 Then
Set oOutlookApp = CreateObject("Outlook.Application")
bStarted = True
End If

'Create a new mailitem
Set oItem = oOutlookApp.CreateItem(olMailItem)

With oItem
'Set the recipient for a copy
.CC = "(e-mail address removed)"
'.CC = "(e-mail address removed)"
'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"
.Display
End With

'If we started Outlook from code, then close it
If bStarted Then
oOutlookApp.Quit
End If

'Clean up
Set oItem = Nothing
Set oOutlookApp = Nothing

'reset protection in the original document
ActiveDocument.Unprotect Password:="equities"

'original protection settings
ActiveDocument.Sections(1).ProtectedForForms = True
ActiveDocument.Sections(2).ProtectedForForms = False
ActiveDocument.Sections(3).ProtectedForForms = True
ActiveDocument.Protect Password:="equities", NoReset:=False, Type:= _
wdAllowOnlyFormFields

ActiveDocument.Save


End Sub

 

[muyBN]

Jeanmac, the following code works for me in not getting a prompt for a file I
want to attach. The only drawback is that sometimes it doesn't open the
Outlook application as it should and I have to do it manually; thus, the "On
Error Resume Next" provision in my code. Adapt this code as appropriate for
yourself.

Sub SendFile()
Dim strOrig As String
Dim objOutlookApp As Outlook.Application, objItem As Outlook.MailItem
Dim OLI As Outlook.Inspector, strAccountBtnName As String, intLoc As
Integer, blnStarted As Boolean
Dim CBs As Office.CommandBars, CBP As Office.CommandBarPopup, MC As
Office.CommandBarControl
Const ID_ACCOUNTS = 31224

'identify whatever file you want to use as attachment
strOrig = ActiveDocument.name
Documents(strOrig).Activate
On Error Resume Next
Set objOutlookApp = GetObject(, "Outlook.Application")
If Err <> 0 Then
Set objOutlookApp = CreateObject("Outlook.Application")
blnStarted = True
End If
If objOutlookApp Is Nothing Then
Set objOutlookApp = CreateObject("Outlook.Application")
blnStarted = True
End If
Set objItem = objOutlookApp.CreateItem(olMailItem)
'select account to send from (adapted from
http://www.outlookcode.com/codedetail.aspx?id=889)
Set OLI = objItem.GetInspector
On Error GoTo 0
If Not OLI Is Nothing Then
Set CBs = OLI.CommandBars
Set CBP = CBs.FindControl(, ID_ACCOUNTS)
If Not CBP Is Nothing Then
For Each MC In CBP.Controls
intLoc = InStr(MC.Caption, " ")
If intLoc > 0 Then
strAccountBtnName = Mid(MC.Caption, intLoc + 1)
Else
strAccountBtnName = MC.Caption
End If
GoTo Exit_Function
Next
End If
End If
Documents(strOrig).Activate
If ActiveDocument.name <> strOrig Then Documents.Open "[path]" & strOrig
With objItem
.To = [e-mail address; I generate this with variables derived from
my database]
.Subject = "[subject; also derived from my database]"
.Body = "[your message]"
.Display
End With
Selection.InsertFile FileName:="[path]" & strOrig, Range:="",
ConfirmConversions:=False, Link:=False, Attachment:=True
Exit_Function:
Set MC = Nothing
Set CBP = Nothing
Set CBs = Nothing
Set OLI = Nothing
Set objItem = Nothing
Set objOutlookApp = Nothing
End Sub