[x]
Posted via EE Mobile

Search, ask, and monitor your questions on the go with EE Mobile. Visit Experts Exchange from your mobile device and never be out of touch again.
Question
[x]
Attachment Details
[x]
The Solution Rating System

With so many solutions, how can you tell which solutions are most likely to help you and which ones are not? To provide you with a tool to use, we rate our solutions based on various elements that most accurately determine if a solution is a quality solution. To explain what factors affect the solution rating, here are the elements we take into consideration when formulating our solution rating.

  • The Grade of the Solution
  • The Zone Rank of the Expert Providing the Solution
  • The Number of Author and Expert Comments
  • The Number of Experts Contributing
  • The Feedback of the Community

Your Input Matters
Because of the way the system is set up, the most important variable in this equation is you. As a member of Experts Exchange, you are able to cast your vote on the quality of the solutions in regard to how complete, accurate, helpful and easy to understand each solution is. When you provide your feedback, each rating is adjusted accordingly. So, if you see a solution that has a poor rating that you think is a good solution, let us know by rating it. As you do, the rating will be adjusted and will become more accurate for other members of our site.

If you have any suggestions that you would like to make for our rating system, please ask a question in the Suggestions Zone of Community Support.

Thank you!
9.3

Send mail from Access

Asked by sonnevelt in Access Coding/Macros

Hello i have a routine to send email messages from MS Access 2003.
For this routine i use a VBA module in MS Outlook 2003.

Everything works fine but there is just a litlle cosmetic problem.
In the event that Outlook is allready running there's no problem
The VBA code checks if Outlook is running and when Outlook isn't running it will start it,
in a minimized window so there's only a tasbar button visible.

In the event that Outlook is tsarted by VBA code and the first message is send, the VBA editor in Outlook pops up, displaying the VBA module.

I can't find what's causing this problem, maybe you can?

Many thanx in advance

Gijsbert 
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:

---------------------------------> Outlook VBA routine
 
Option Explicit
 
' Code: Send E-mail without Security Warnings
' Please leave the copyright notices in place - Thank you.
 
Private Sub Application_Startup()
 
    'IGNORE - This forces the VBA project to open and be accessible using automation
    '         at any point after startup
 
End Sub
 
' FnSendMailSafe
' --------------
' Simply sends an e-mail using Outlook/Simple MAPI.
' Calling this function by Automation will prevent the warnings
' 'A program is trying to send a mesage on your behalf...'
' Also features optional HTML message body and attachments by file path. 
'
' The To/CC/BCC/Attachments function parameters can contain multiple items by seperating
' them by a semicolon. (e.g. for the strTo parameter, 'test@test.com; test2@test.com' is
' acceptable for sending to multiple recipients. 
'                   
Public Function FnSendMailSafe(strTo As String, _
                                strCC As String, _
                                strBCC As String, _
                                strSubject As String, _
                                strMessageBody As String, _
                                Optional strAttachments As String) As Boolean
 
' (c) 2005 Wayne Phillips - Written 07/05/2005
' Last updated 26/03/2008 - Bugfix for empty recipient strings
' http://www.everythingaccess.com
'
' You are free to use this code within your application(s)
' as long as the copyright notice and this message remains intact.
 
On Error GoTo ErrorHandler:
 
    Dim MAPISession As Outlook.NameSpace
    Dim MAPIFolder As Outlook.MAPIFolder
    Dim MAPIMailItem As Outlook.MailItem
    Dim oRecipient As Outlook.Recipient
    
    Dim TempArray() As String
    Dim varArrayItem As Variant
    Dim strEmailAddress As String
    Dim strAttachmentPath As String
    
    Dim blnSuccessful As Boolean
 
    'Get the MAPI NameSpace object
    Set MAPISession = Application.Session
    
    If Not MAPISession Is Nothing Then
 
      'Logon to the MAPI session
      MAPISession.Logon , , True, False
 
      'Create a pointer to the Outbox folder
      Set MAPIFolder = MAPISession.GetDefaultFolder(olFolderOutbox)
      If Not MAPIFolder Is Nothing Then
 
        'Create a new mail item in the "Outbox" folder
        Set MAPIMailItem = MAPIFolder.Items.Add(olMailItem)
        If Not MAPIMailItem Is Nothing Then
          
          With MAPIMailItem
 
            'Create the recipients TO
                TempArray = Split(strTo, ";")
                For Each varArrayItem In TempArray
                
                    strEmailAddress = Trim(varArrayItem)
                    If Len(strEmailAddress) > 0 Then
                        Set oRecipient = .Recipients.Add(strEmailAddress)
                        oRecipient.Type = olTo
                        Set oRecipient = Nothing
                    End If
                
                Next varArrayItem
            
            'Create the recipients CC
                TempArray = Split(strCC, ";")
                For Each varArrayItem In TempArray
                
                    strEmailAddress = Trim(varArrayItem)
                    If Len(strEmailAddress) > 0 Then
                        Set oRecipient = .Recipients.Add(strEmailAddress)
                        oRecipient.Type = olCC
                        Set oRecipient = Nothing
                    End If
                
                Next varArrayItem
            
            'Create the recipients BCC
                TempArray = Split(strBCC, ";")
                For Each varArrayItem In TempArray
                
                    strEmailAddress = Trim(varArrayItem)
                    If Len(strEmailAddress) > 0 Then
                        Set oRecipient = .Recipients.Add(strEmailAddress)
                        oRecipient.Type = olBCC
                        Set oRecipient = Nothing
                    End If
                
                Next varArrayItem
            
            'Set the message SUBJECT
                .Subject = strSubject
            
            'Set the message BODY (HTML or plain text)
                If StrComp(Left(strMessageBody, 6), "<HTML>", vbTextCompare) = 0 Then
                    .HTMLBody = strMessageBody
                Else
                    .Body = strMessageBody
                End If
 
            'Add any specified attachments
                TempArray = Split(strAttachments, ";")
                For Each varArrayItem In TempArray
                
                    strAttachmentPath = Trim(varArrayItem)
                    If Len(strAttachmentPath) > 0 Then
                        .Attachments.Add strAttachmentPath
                    End If
                
                Next varArrayItem
 
            .Send 'No return value since the message will remain in the outbox if it fails to send
 
            Set MAPIMailItem = Nothing
            
          End With
 
        End If
 
        Set MAPIFolder = Nothing
      
      End If
 
      MAPISession.Logoff
      
    End If
    
    'If we got to here, then we shall assume everything went ok.
    blnSuccessful = True
    
ExitRoutine:
    Set MAPISession = Nothing
    FnSendMailSafe = blnSuccessful
    
    Exit Function
    
ErrorHandler:
    MsgBox "An error has occured in the user defined Outlook VBA function FnSendMailSafe()" & vbCrLf & vbCrLf & _
            "Error Number: " & CStr(Err.Number) & vbCrLf & _
            "Error Description: " & Err.Description, vbApplicationModal + vbCritical
    Resume ExitRoutine
 
End Function
 
---------------------------->! Code in access form
Set db = CurrentDb
Set rs = db.OpenRecordset("tblContributie")
rs.Filter = "txtEmail IS NOT NULL"
Set rsFilter = rs.OpenRecordset
rsFilter.MoveLast
RecCount = rsFilter.RecordCount
rsFilter.MoveFirst
 
ProgressBar.Max = RecCount
ProgressBar = 0
 
Do Until rsFilter.EOF = True
    
    Schutter = rsFilter("txtSchutter")
    Adres = rsFilter("txtAdres")
    PCWP = rsFilter("txtPCWP")
    Euro = rsFilter("txtEuro")
    Datum = rsFilter("txtDatum")
    Club = rsFilter("txtClub")
    KNSA = rsFilter("txtKNSA")
    Voornaam = rsFilter("txtVoornaam")
    Lidmaatschap = rsFilter("txtLidmaatschap")
    Licentie = rsFilter("txtLicentie")
    strEmail = rsFilter("txtEmail")
    lblPbar.Visible = True
    lblPbar.Caption = "PDF aanmaken voor: " & Me.Schutter
    DoEvents
    
    strReport = Me.Licentie & "_Contributie nota.pdf"
    blRet = ConvertReportToPDF("rptContributie_Email", vbNullString, strReport, False, False, 150, "", "", 0, 0, 0)
 
        lblPbar.Caption = "Email verzenden naar: " & Me.Schutter
        DoEvents
            strBody = bla bla bla bal " & vbCrLf & vbCrLf & vbCrLf & _
                  "Ik hoop je hiermee voldoende te hebben geinformeerd," & vbCrLf & vbCrLf & _
                  "Met vriendelijke groet," & vbCrLf & _
                  Me.txtPenningmeester & vbCrLf & vbCrLf & vbCrLf & vbCrLf & _
                  "Penningmeester."
 
        blnSuccessful = FnSafeSendEmail(strEmail, "Nota jaarlijkse contributie.", strBody, CurrentProject.path & "\Nota's\" & Licentie & "_Contributie nota.pdf")
           If blnSuccessful Then
              'MsgBox "E-mail message sent successfully!"
           Else
               MsgBox "Fout bij verzenden van e-mail!"
           End If
 
ProgressBar = ProgressBar + 1
rsFilter.MoveNext
Loop
[+][-]10/31/09 03:20 AM, ID: 25709095Accepted Solution

View this solution now by starting your 30-day free trial. Setting up your free trial is quick, easy, and secure. We will return you to this solution, unlocked, when you're done.

About this solution

Zone: Access Coding/Macros
Sign Up Now!
Solution Provided By: MikeToole
Participating Experts: 2
Solution Grade: A
 
[+][-]10/31/09 04:16 AM, ID: 25709225Expert Comment

At Experts Exchange, members can ask their questions to thousands of technology professionals, also known as Experts. Experts compete and collaborate to answer those questions by leaving comments like this one.

Start your 30-day free trial to view this Expert Comment or ask the Experts your question.

 
 
Loading Advertisement...
20091111-EE-VQP-92 - Hierarchy / EE_QW_3_20080625