attach workbook to email

[robcarr]

Dear All,

I am using the coding below to create a message to send out daily, What I need to do is attach the current workbook to the email message. Here is the coding I have so far, I can figure out how to attach the file to the message I am creating.

Sub auto_close()
Dim Msgs, response, style
Dim Email As String, Subj As String
Dim Msg As String, URL As String


Msgs = "Do you want to send the file to Exeter"
style = vbYesNo + vbInformation
response = MsgBox(Msgs, style)

If response = vbYes Then
Application.ScreenUpdating = False

' Get the email address
Email = "anyone@help.com"


' Message subject
Subj = "Daily Derby Stats"

' Compose the message
Msg = ""
Msg = Msg & "Dear All" & "." & vbCrLf & vbCrLf
Msg = Msg & "Please find attached the daily report"
Msg = Msg & " for yesterday." & vbCrLf & vbCrLf
Msg = Msg & "If you have any queries can you please let me know." & vbCrLf & vbCrLf

' Replace spaces with %20 (hex)
Subj = Application.WorksheetFunction.Substitute(Subj, " ", "%20&quot
Msg = Application.WorksheetFunction.Substitute(Msg, " ", "%20&quot




' Replace carriage returns with %0D%0A (hex)
Msg = Application.WorksheetFunction.Substitute(Msg, vbCrLf, "%0D%0A&quot
' Create the URL
URL = "mailto:" & Email & "?subject=" & Subj & "&body=" & Msg



' Execute the URL (start the email client)
ShellExecute 0&, vbNullString, URL, vbNullString, vbNullString, vbNormalFocus

' Wait two seconds before sending keystrokes
Application.Wait (Now + TimeValue("0:00:01&quot)
Application.SendKeys "%s"
ActiveWorkbook.Save
Else
ActiveWorkbook.Save

End If

End Sub

any help greatly appreciated.

Rob.

 

[mp9]

Application.Dialogs(xlDialogSendMail).Show

sens the current workbook as an attachment, I believe. Does this help?

http://www22.brinkster.com/accessory/

 

[RobBroekhuis]

Assuming you're using Outlook as your mail program, you're better off sending the mail through outlook from your Excel VBA code. The code below isn't mine (I got it from somewhere off the web and modified it to suit my needs), but it works just fine, for a single-attachment message.
You probably need to set the proper references in VBE first, so that VBE recognizes the Outlook objects.
Rob

Public Function InitializeOutlook() As Boolean
On Error GoTo Init_Err
Set golApp = New Outlook.Application
Set gnspNameSpace = golApp.GetNamespace("MAPI&quot
InitializeOutlook = True
Init_End:
Exit Function
Init_Err:
InitializeOutlook = False
Resume Init_End
End Function

Function CreateMail(astrRecip As Variant, _
strSubject As String, _
strMessage As String, _
astrAttachment As String) As Boolean

Dim objNewMail As Outlook.MailItem
Dim varRecip As Variant
Dim varAttach As Variant
Dim blnResolveSuccess As Boolean

On Error GoTo CreateMail_Err
If golApp Is Nothing Then
If InitializeOutlook = False Then
MsgBox "Unable to initialize Outlook Application " _
& "or NameSpace object variables!"
Exit Function
End If
End If

Set golApp = New Outlook.Application
Set objNewMail = golApp.CreateItem(olMailItem)
With objNewMail
For Each varRecip In astrRecip
.Recipients.Add varRecip
Next varRecip
blnResolveSuccess = .Recipients.ResolveAll
.Attachments.Add astrAttachment, , , Mid(astrAttachment, InStrRev(astrAttachment, "\&quot + 1)
.Subject = strSubject
.Body = strMessage
If blnResolveSuccess Then
.Send
Else
MsgBox "Unable to resolve all recipients. Please check " _
& "the names."
.Display
End If
End With
CreateMail = True

CreateMail_End:
Exit Function
CreateMail_Err:
CreateMail = False
Resume CreateMail_End
End Function

 

[acron]

If you can manage without an actual message you could use

ActiveWorkbook.Sendmail _
Recipient:= "anyone@help.com" _
Subject:= "Daily Report"

With your existing code you could use

Attachments.Add ActiveWork.Fullname

You should save the file before actually sending it.

A.C.