Email to selected list option

C

crann

Registered User.
Local time
Today, 23:07
Joined
Nov 23, 2002
Messages
160
Hi

I have a form called: frmNewWork and a table tblNewWork which I use to create new jobs for then email the report to the relevant team member.

At the moment the Cmd has a fixed email address in which I type in the new email address I wish to send to.

On my form I have a drop down list with the team members details in including their email address which I then have displayed in a text box called: txtone.

The drop down list is called:TeamDetails

Am I able to add the selected email address into the cmd button code?

So the report is emailed to who ever I select in the drop down list providing an email address is present.

This is what I currently use:

Thank You

Private Sub Command181_Click()

Dim stDocName As String


stDocName = "Report"

DoCmd.OpenReport stDocName, acPreview, , "[ID] = " & Me.ID

DoCmd.SendObject acSendReport, "Report", acFormatPDF, "me@email.com.com", "myCC@email.com", "Report Breakdown", "Your Report has been attached."

End Sub
 
DoCmd.SendObject acSendReport, "Report", acFormatPDF, Me.TeamDetails.Value & "" , "myCC@email.com", "Report Breakdown", "Your Report has been attached."
 
Arnelgp

Thanks very much great response time too, so so helpful, worked great

Is it possible to send that email in silence i.e use the .send code somehow?

So I dont need to keep pressing send within Outlook.

Thanks
 
you have to use outlook automation to do that.
open VBE (Alt-F11) and add new module
while on VBE, on menu Tools->Reference, add Microsoft Outlook xx.xx Object Library.

paste this code in the module:


Code: 
Public Sub CreateEmailWithOutlook( _
    MessageTo As String, _
    MessageCC As String, _
    Subject As String, _
    MessageBody As String)

    ' Define app variable and get Outlook using the "New" keyword
    Dim olApp As New Outlook.Application
    Dim olMailItem As Outlook.MailItem  ' An Outlook Mail item
 
    ' Create a new email object
    Set olMailItem = olApp.CreateItem(olMailItem)

    ' Add the To/Subject/Body to the message and display the message
    With olMailItem
        .To = MessageTo
        .CC = MessageCC
        .Subject = Subject
        .Body = MessageBody
        '.Display    ' To show the email message to the user
         .Send
    End With

    ' Release all object variables
    Set olMailItem = Nothing
    Set olApp = Nothing

End Sub


    Public Function SpecialFolderPath(strFolder As String) As String
        ' Find out the path to the passed special folder. User on of the following arguments:
        ' Options For specical folders
    '        AllUsersDesktop
    '        AllUsersStartMenu
    '        AllUsersPrograms
    '        AllUsersStartup
    '        Desktop
    '        Favorites
    '        Fonts
    '        MyDocuments
    '        NetHood
    '        PrintHood
    '        Programs
    '        Recent
    '        SendTo
    '        StartMenu
    '        Startup
    '        Templates
     
       On Error GoTo ErrorHandler
     
       'Create a Windows Script Host Object
          Dim objWSHShell As Object
          Set objWSHShell = CreateObject("WScript.Shell")
     
       'Retrieve path
          SpecialFolderPath = objWSHShell.SpecialFolders(strFolder & "")
     
CleanUp:
       ' Clean up
          Set objWSHShell = Nothing
          Exit Function
     
    '**************************************
    '*      Error Handler
    '**************************************
ErrorHandler:
        MsgBox "Error finding " & strFolder, vbCritical + vbOKOnly, "Error"
        Resume CleanUp
    End Function
then we change your command button click event:
Code: 
Private Sub Command181_Click()

Dim strDocName As String
Dim strPath As String

strDocName = "Report"
' save report to myDocument
strPath = SpecialFolderPath("MyDocuments") & "\"

If Dir(strPath & strDocName & ".pdf") Then Kill strPath & strDocName & ".pdf"
' open report in print preview
DoCmd.OpenReport strDocName, acPreview, , "[ID] = " & Me.ID
' create pdf file in mydocuments
DoCmd.OutputTo acOutputReport, strDocName, acFormatPDF, _
    strPath & strDocName & ".pdf", True

' email this report
CreateEmailWithOutlook "myCC@email.com", Me.TempDetails.Value & "", "Report Breakdown", "Your report has been attached."
'
' in case you want to revert to this, just uncomment...
'DoCmd.SendObject acSendReport, "Report", acFormatPDF, "me@email.com.com", "myCC@email.com", "Report Breakdown", "Your Report has been attached."

End Sub
 
Ok couple of things,
Does it matter what I call the module?
When I run this the follow code appears as red error:

Thanks


Option Compare Database

Public Sub CreateEmailWithOutlook( _
MessageTo As String, _
MessageCC As String
Subject As String, _
MessageBody As String)

' Define app variable and get Outlook using the "New" keyword
Dim olApp As New Outlook.Application
Dim olMailItem As Outlook.MailItem ' An Outlook Mail item

' Create a new email object
Set olMailItem = olApp.CreateItem(olMailItem)

' Add the To/Subject/Body to the message and display the message
With olMailItem
.To = MessageTo
.CC = MessageCC
.Subject = Subject
.Body = MessageBody
'.Display ' To show the email message to the user
.Send
End With

' Release all object variables
Set olMailItem = Nothing
Set olApp = Nothing

End Sub
 
yes, it doesn't matter, but it would be nice if you name it, like modUtility or something.
sorry for that:

Public Sub CreateEmailWithOutlook( _
MessageTo As String, _
MessageCC As String, _
Subject As String, _
MessageBody As String)
 
Ok thanks have renamed it ModUtility which makes sense.

Now have error on cmd button code in yellow?


Private Sub Command181_Click()

Dim strDocName As String
Dim strPath As String

strDocName = "Report"
' save report to myDocument
strPath = SpecialFolderPath("MyDocuments") & "\"

If Dir(strPath & strDocName & ".pdf") Then Kill strPath & strDocName & ".pdf"
' open report in print preview
DoCmd.OpenReport strDocName, acPreview, , "[ID] = " & Me.ID
' create pdf file in mydocuments
DoCmd.OutputTo acOutputReport, strDocName, acFormatPDF, _
strPath & strDocName & ".pdf", True

' email this report
CreateEmailWithOutlook "myCC@email.com", Me.txtone.Value & "", "Report Breakdown", "Your report has been attached."
'
' in case you want to revert to this, just uncomment...
'DoCmd.SendObject acSendReport, "Report", acFormatPDF, "me@email.com.com", "myCC@email.com", "Report Breakdown", "Your Report has been attached."

End Sub
 
what am i thinking, my fault, i just have it so quick:

If Dir(strPath & strDocName & ".pdf") <> "" Then Kill strPath & strDocName & ".pdf"
 
No problem I am very grateful for your help.

Had visual basic error pop saying: Run time 91, object variable or with block variable not set

Then error on this code?


Public Sub CreateEmailWithOutlook( _
MessageTo As String, _
MessageCC As String, _
Subject As String, _
MessageBody As String)




' Define app variable and get Outlook using the "New" keyword
Dim olApp As New Outlook.Application
Dim olMailItem As Outlook.MailItem ' An Outlook Mail item

' Create a new email object
Set olMailItem = olApp.CreateItem(olMailItem)

' Add the To/Subject/Body to the message and display the message
With olMailItem
.To = MessageTo
.CC = MessageCC
.Subject = Subject
.Body = MessageBody
'.Display ' To show the email message to the user
.Send
End With

' Release all object variables
Set olMailItem = Nothing
Set olApp = Nothing

End Sub
 
please be patient, we have not instantiate an Outlook application:

Set OlApp = New Outlook.Application
Set olMailItem = olApp.CreateItem(olMailItem)
 
Ok,

Same error even after I have added in the Set OlApp code

Thanks
 
modified, we forgot to add the report as attachment:
Code: 
Private Sub Command181_Click()

Dim strDocName As String
Dim strPath As String

strDocName = "Report"
' save report to myDocument
strPath = SpecialFolderPath("MyDocuments") & "\"

If Dir(strPath & strDocName & ".pdf") Then Kill strPath & strDocName & ".pdf"
' open report in print preview
DoCmd.OpenReport strDocName, acPreview, , "[ID] = " & Me.ID
' create pdf file in mydocuments
DoCmd.OutputTo acOutputReport, strDocName, acFormatPDF, _
    strPath & strDocName & ".pdf", True

' email this report
CreateEmailWithOutlook "myCC@email.com", Me.TempDetails.Value & "", "Report Breakdown", "Your report has been attached.", _
        strPath & strDocName & ".pdf"
'
' in case you want to revert to this, just uncomment...
'DoCmd.SendObject acSendReport, "Report", acFormatPDF, "me@email.com.com", "myCC@email.com", "Report Breakdown", "Your Report has been attached."

End Sub


Code: 
Public Function CreateEmailWithOutlook( _
    MessageTo As String, _
    MessageCC As String
    Subject As String, _
    MessageBody As String, _
     AttachmentFile As String)

    ' Define app variable and get Outlook using the "New" keyword
    Dim olApp As New Outlook.Application
    Dim olMailItm As Outlook.MailItem  ' An Outlook Mail item
    Dim olFolder As Outlook.Folder
    Dim olNameSpace As Outlook.NameSpace
 

    Set olApp = New Outlook.Application
    Set olNameSpace = olApp.GetNamespace("MAPI")
    Set olFolder = olNameSpace.GetDefaultFolder(olFolderInbox)
    ' Create a new email object
    Set olMailItm =olFolder.Items.Add(olMailItem)

    ' Add the To/Subject/Body to the message and display the message
    With olMailItm
        .To = MessageTo
        .CC = MessageCC
        .Subject = Subject
        .Body = MessageBody
       .Attachment.Add AttachmentFile
        '.Display    ' To show the email message to the user
         .Send
    End With

    ' Release all object variables
    Set olMailItm = Nothing
    Set olFolder=Nothing
    Set olNameSpace=Nothing
    Set olApp = Nothing

End Function
 
Last edited:
Ok

It is now sending an email to the correct address but no report for that record is attached.

Its also leaving the preview of the report on screen

Thanks so much
 
replace this line on your command button click event:

DoCmd.OpenReport strDocName, acPreview, , "[ID] = " & Me.ID, acHidden
' create pdf file in mydocuments
DoCmd.OutputTo acOutputReport, strDocName, acFormatPDF, _
strPath & strDocName & ".pdf", True
'close the report
DoCmd.Close acReport, strDocName

' email this report
CreateEmailWithOutlook "myCC@email.com", Me.TempDetails.Value & "", "Report Breakdown", "Your report has been attached.", _
strPath & strDocName & ".pdf"


--------
Please see changes on my last post about CreateEmailWithOutlook sub, i edited it.
 
Here is my updated code below
Just for your information the field containing the email address for team now is: txtone

I am getting the error message: Compile error, Wrong number of arguments or invalid property assignment.

Private Sub Command181_Click()

Dim strDocName As String
Dim strPath As String

strDocName = "Report"
' save report to myDocument
strPath = SpecialFolderPath("MyDocuments") & "\"


If Dir(strPath & strDocName & ".pdf") <> "" Then Kill strPath & strDocName & ".pdf"


DoCmd.OpenReport strDocName, acPreview, , "[ID] = " & Me.ID, acHidden
' create pdf file in mydocuments
DoCmd.OutputTo acOutputReport, strDocName, acFormatPDF, _
strPath & strDocName & ".pdf", True
'close the report
DoCmd.Close acReport, strDocName

' email this report
CreateEmailWithOutlook Me.txtone.Value & "", "info@conquerltd.com", "Report Breakdown", "Your report has been attached.", _
strPath & strDocName & ".pdf"



End Sub
 
have you copied the CreateEmailWithOutlook sub on my last post. i edited it so that it now accepts 5 parameters, including the attachment.
 
Here is my CmdButton:

Private Sub Command181_Click()

Dim strDocName As String
Dim strPath As String

strDocName = "Report"
' save report to myDocument
strPath = SpecialFolderPath("MyDocuments") & "\"

If Dir(strPath & strDocName & ".pdf") Then Kill strPath & strDocName & ".pdf"
' open report in print preview



DoCmd.OpenReport strDocName, acPreview, , "[ID] = " & Me.ID, acHidden
' create pdf file in mydocuments
DoCmd.OutputTo acOutputReport, strDocName, acFormatPDF, _
strPath & strDocName & ".pdf", True
'close the report
DoCmd.Close acReport, strDocName

' email this report
CreateEmailWithOutlook "myCC@email.com", Me.txtone.Value & "", "Report Breakdown", "Your report has been attached.", _
strPath & strDocName & ".pdf"



End Sub




Here is my ModUtility Code:

Public Function CreateEmailWithOutlook( _
MessageTo As String, _
MessageCC As String, _
Subject As String, _
MessageBody As String)

' Define app variable and get Outlook using the "New" keyword
Dim olApp As New Outlook.Application
Dim olMailItm As Outlook.MailItem ' An Outlook Mail item
Dim olFolder As Outlook.Folder
Dim olNameSpace As Outlook.NameSpace


Set olApp = New Outlook.Application
Set olNameSpace = olApp.GetNamespace("MAPI")
Set olFolder = olNameSpace.GetDefaultFolder(olFolderInbox)
' Create a new email object
Set olMailItm = olFolder.Items.Add(olMailItem)

' Add the To/Subject/Body to the message and display the message
With olMailItm
.To = MessageTo
.CC = MessageCC
.Subject = Subject
.Body = MessageBody
.Attachment.Add AttachmentFile
'.Display ' To show the email message to the user
.Send
End With

' Release all object variables
Set olMailItm = Nothing
Set olFolder = Nothing
Set olNameSpace = Nothing
Set olApp = Nothing

End Sub


Public Function SpecialFolderPath(strFolder As String) As String
' Find out the path to the passed special folder. User on of the following arguments:
' Options For specical folders
' AllUsersDesktop
' AllUsersStartMenu
' AllUsersPrograms
' AllUsersStartup
' Desktop
' Favorites
' Fonts
' MyDocuments
' NetHood
' PrintHood
' Programs
' Recent
' SendTo
' StartMenu
' Startup
' Templates

On Error GoTo ErrorHandler

'Create a Windows Script Host Object
Dim objWSHShell As Object
Set objWSHShell = CreateObject("WScript.Shell")

'Retrieve path
SpecialFolderPath = objWSHShell.SpecialFolders(strFolder & "")

CleanUp:
' Clean up
Set objWSHShell = Nothing
Exit Function

'**************************************
'* Error Handler
'**************************************
ErrorHandler:
MsgBox "Error finding " & strFolder, vbCritical + vbOKOnly, "Error"
Resume CleanUp
End Function
 
Public Function CreateEmailWithOutlook( _
MessageTo As String, _
MessageCC As String, _
Subject As String, _
MessageBody As String, _
AttachmentFile As String)
 
Error here: in yellow

Public Function CreateEmailWithOutlook( _
MessageTo As String, _
MessageCC As String, _
Subject As String, _
MessageBody As String)

' Define app variable and get Outlook using the "New" keyword
Dim olApp As New Outlook.Application
Dim olMailItm As Outlook.MailItem ' An Outlook Mail item
Dim olFolder As Outlook.Folder
Dim olNameSpace As Outlook.NameSpace


Set olApp = New Outlook.Application
Set olNameSpace = olApp.GetNamespace("MAPI")
Set olFolder = olNameSpace.GetDefaultFolder(olFolderInbox)
' Create a new email object
Set olMailItm = olFolder.Items.Add(olMailItem)

' Add the To/Subject/Body to the message and display the message
With olMailItm
.To = MessageTo
.CC = MessageCC
.Subject = Subject
.Body = MessageBody
.Attachment.Add AttachmentFile
'.Display ' To show the email message to the user
.Send
End With

' Release all object variables
Set olMailItm = Nothing
Set olFolder = Nothing
Set olNameSpace = Nothing
Set olApp = Nothing

End Sub
 
yes, there is an error, ive posted the correct header for the that sub, just replace this:

Public Function CreateEmailWithOutlook( _
MessageTo As String, _
MessageCC As String, _
Subject As String, _
MessageBody As String)

with this:

Public Function CreateEmailWithOutlook( _
MessageTo As String, _
MessageCC As String, _
Subject As String, _
MessageBody As String, _
AttachmentFile As String)
 
You must log in or register to reply here.

Similar threads

A
Send Report Through Access Form
Replies
10
Views
1,016
Gasman
Gasman
A
Solved Email Report
Replies
13
Views
1,294
adamsro
A
J
Can't fill in a subform
Replies
13
Views
1,422
Jen-Jen
J
D
Solved Disable Multiple Record Selection On Subform
Replies
7
Views
439
dalski
D
MattBaldry
Solved Multi-Select List Box, Distinct Values
Replies
17
Views
1,249
Ken Sheridan
Ken Sheridan

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom