кто автор уже не помню(извеняюсь), давно стянула с какого-то форума
сама ею пользуюсь

Public Sub SendEmailAtt(ByVal MyTo As String, MySybject As String, _
Optional MyBody As String, Optional MyAttachment As String)
Dim OutLookApp As Object
Dim OutLookItem As Object
Dim OlNotRunning As Boolean

On Error Resume Next
Set OutLookApp = GetObject(, "Outlook.Application")
If err.Number <> 0 Then
OlNotRunning = True
err.Clear
Set OutLookApp = CreateObject("Outlook.Application")
End If
Set OutLookItem = OutLookApp.CreateItem(0)
With OutLookItem
.TO = MyTo
.Subject = MySybject
.Body = MyBody
If Dir(MyAttachment) <> "" Then
.Attachments.Add MyAttachment
End If
'.Display
.Send
End With
If OlNotRunning = True Then
OutLookApp.Application.Quit
End If
End Sub