I am on the same page with going home. 30 minutes and the 60 freeway is mine.
Well that is a lot of code. Is all of that in a module? and how is it called?
Jim Wagner
On Friday, February 6, 2015 4:25 PM, "Liz Ravenwood liz_ravenwood@beaerospace.com [MS_Access_Professionals]" <MS_Access_Professionals@yahoogroups.com> wrote:
Hey Jim,
It's about happy hour, so I don't want to compare line by line, but this is how I'm doing it:
Option Compare Database
Option Explicit
Public outlookApp As Outlook.Application
Public outlookNamespace As Outlook.Namespace
Public Function AttachmentSent(varTo As Variant, varSub As Variant, varBody As Variant, varFile As Variant)
On Error GoTo errOut
InitOutlook
Dim mailItem As Outlook.mailItem
Set mailItem = outlookApp.CreateItem(olMailItem)
mailItem.To = varTo
mailItem.Subject = varSub
mailItem.Body = varBody
mailItem.Attachments.Add (varFile)
mailItem.Send
Set mailItem = Nothing
CleanUp
AttachmentSent = True
Exit Function
errOut:
If Err.Number = -2147467259 Then
MsgBox ("Outlook not recognizing one or more names.")
Resume Next
ElseIf Err.Number = 287 Then
MsgBox ("You didn't allow the email to be sent.")
Else
MsgBox ("Error in module Email: AttachmentSent & " & Err.Number & vbCrLf & Err.Description)
End If
End Function
Public Function MailSent(varTo As Variant, varSub As Variant, Optional varBody As Variant, Optional varHTMLBody As String) As Boolean
On Error GoTo errOut
InitOutlook
Dim mailItem As Outlook.mailItem
Set mailItem = outlookApp.CreateItem(olMailItem)
mailItem.To = varTo
mailItem.Subject = varSub
If varBody = "" Then
mailItem.HTMLBody = varHTMLBody
Else
mailItem.Body = varBody
End If
mailItem.Send
Set mailItem = Nothing
CleanUp
MailSent = True
Exit Function
errOut:
If Err.Number = -2147467259 Then
MsgBox ("Outlook not recognizing one or more names.")
MailSent = False
ElseIf Err.Number = 287 Then
MailSent = False
Else
MsgBox ("Error in module Email: MailSent & " & Err.Number & vbCrLf & Err.Description)
MailSent = False
End If
End Function
Public Sub SendAlong(varTo As Variant, varSub As Variant, varBody As Variant)
On Error GoTo errOut
InitOutlook
Dim mailItem As Outlook.mailItem
Set mailItem = outlookApp.CreateItem(olMailItem)
mailItem.To = varTo
mailItem.Subject = varSub
mailItem.Body = varBody
mailItem.Send ' ? breaking with error 438 object doesn't support this property or method
Set mailItem = Nothing
CleanUp
Exit Sub
errOut:
If Err.Number = -2147467259 Then
MsgBox ("Outlook not recognizing one or more names.")
Resume Next
ElseIf Err.Number = 287 Then
Resume Next
Else
MsgBox ("Error in module Email: SendAlong " & Err.Number & vbCrLf & Err.Description)
End If
End Sub
Public Sub SendAttachment(varTo As Variant, varSub As Variant, varBody As Variant, varFile As Variant)
On Error GoTo errOut
InitOutlook
Dim mailItem As Outlook.mailItem
Set mailItem = outlookApp.CreateItem(olMailItem)
mailItem.To = varTo
mailItem.Subject = varSub
mailItem.Body = varBody
mailItem.Attachments.Add (varFile)
mailItem.Send
Set mailItem = Nothing
CleanUp
Exit Sub
errOut:
If Err.Number = -2147467259 Then
MsgBox ("Outlook not recognizing one or more names.")
Resume Next
Else
MsgBox ("Error in module Email: SendAttachment & " & Err.Number & vbCrLf & Err.Description)
End If
End Sub
Public Sub InitOutlook()
' Initialize a session in Outlook
Set outlookApp = New Outlook.Application
'Return a reference to the MAPI layer
Set outlookNamespace = outlookApp.GetNamespace("MAPI")
'Let the user logon to Outlook with the
'Outlook Profile dialog box
'and then create a new session
outlookNamespace.Logon , , True, False
End Sub
Public Sub CleanUp()
' Clean up public object references.
Set outlookNamespace = Nothing
Set outlookApp = Nothing
End Sub
From: MS_Access_Professionals@yahoogroups.com [mailto:MS_Access_Professionals@yahoogroups.com]
Sent: Friday, February 06, 2015 4:16 PM
To: MS_Access_Professionals@yahoogroups.com
Subject: [MS_AccessPros] Email Report in body of email message
Sent: Friday, February 06, 2015 4:16 PM
To: MS_Access_Professionals@yahoogroups.com
Subject: [MS_AccessPros] Email Report in body of email message
Hello everyone,
I have worked on this all day. Literally all day. We send reports all the time that are embedded into a message but the code does some loops and some other things are more than I need. I tried to adapt our code to work with one report and one recipient. And nothing I do is working. I am not sure why I keep getting errors that the objects are not defined. The latest code is below and the error is a compile error which is User-defined type not defined. it stops on the line Dim appOutLook As Outlook.Application
Is there something I do not see?
Private Sub cmdEmailAccomplishmentListReport_Click()
Dim mess_body As String
Dim appOutLook As Outlook.Application
Dim MailOutLook As Outlook.MailItem
Set appOutLook = CreateObject("Outlook.Application")
Set MailOutLook = appOutLook.CreateItem(olMailItem)
Set appOutLook = CreateObject("Outlook.Application")
Set MailOutLook = ! appOutLook.CreateItem(olMailItem)
With MailOutLook
'.BodyFormat = olFormatRichText
.To = "luvmymelody@yahoo.com"
.Subject = "report"
.HTMLBody = ("rptAccomplishmentList")
If Left(Me.Mail_Attachment_Path, 1) <> "<" Then
.Attachments.Add "U:\rptAccomplishmentList.html"
End If
'.DeleteAfterSubmit = True 'Th is would let Outlook send th note without storing it in your sent bin .Send
End With
'MsgBox MailOutLook.Body
Exit Sub
email_error:
MsgBox "An error was encountered." & vbCrLf & "The error message is: " & Err.Description
Resume Error_out
Error_out:
Dim mess_body As String
Dim appOutLook As Outlook.Application
Dim MailOutLook As Outlook.MailItem
Set appOutLook = CreateObject("Outlook.Application")
Set MailOutLook = appOutLook.CreateItem(olMailItem)
Set appOutLook = CreateObject("Outlook.Application")
Set MailOutLook = ! appOutLook.CreateItem(olMailItem)
With MailOutLook
'.BodyFormat = olFormatRichText
.To = "luvmymelody@yahoo.com"
.Subject = "report"
.HTMLBody = ("rptAccomplishmentList")
If Left(Me.Mail_Attachment_Path, 1) <> "<" Then
.Attachments.Add "U:\rptAccomplishmentList.html"
End If
'.DeleteAfterSubmit = True 'Th is would let Outlook send th note without storing it in your sent bin .Send
End With
'MsgBox MailOutLook.Body
Exit Sub
email_error:
MsgBox "An error was encountered." & vbCrLf & "The error message is: " & Err.Description
Resume Error_out
Error_out:
End Sub
I am using early binding if that matters.
Sub CheckBindingLB()
Dim olApp As Object
Set olApp = CreateObject("Outlook.Application")
MsgBox olApp.Name
End Sub
Jim Wagner
This email (and all attachments) is for the sole use of the intended recipient(s) and may contain privileged and/or proprietary information. Any unauthorized review, use, disclosure or distribution is prohibited. If you are not the intended recipient, please contact the sender by reply e-mail and destroy all copies of the original message.
__._,_.___
Posted by: Jim Wagner <luvmymelody@yahoo.com>
| Reply via web post | • | Reply to sender | • | Reply to group | • | Start a New Topic | • | Messages in this topic (3) |
.
__,_._,___
Tidak ada komentar:
Posting Komentar