Hi John,
In need to send emails to members on certain occasions.
For e.g.:
1) Informing Members of Executive Council for a meeting to take place on certain date, place,time etc; this information we may get from a report, or attach a word document (there is no such report currently. The current procedure is sending word doc. via gmail.
2) Informing Members about any event going to take place.
3) I have a form which displays which members have birthday today, so the idea is that they should be sent a birthday wish through email.
At present we do not have out outlook express.
Some time before in past i asked the same question in this group, and got a function from Bill Mosca.
---------------------------------------------------
Public Function Outlook_SendEmail(ByVal strTo As String, _
ByVal strSubject As String, _
ByVal strMsg As String) As Boolean
'Public Function Outlook_SendEmail(ByVal strTo As String, _
' ByVal strSubject As String, _
' ByVal strMsg As String, _
' ParamArray AttachmentList() As Variant) As Boolean
'Purpose : Automatically send email via late-binding Outlook Automation.
' Call like this:
' Call Outlook_SendEmail("Bill.Mosca@MyDomain.com","Hey there.", _
"Here is my message","C:\MyFiles\Test1.txt","C:\MyFiles\Test2.txt")
'DateTime : 11/30/2003 12:12
'Author : Bill Mosca, modified by ChrisO to use Array for attachments.
Dim objOLApp As Object 'Outlook.Application
Dim outItem As Object 'Outlook.MailItem
Dim outFolder As Object 'MAPIFolder
Dim DestFolder As Object 'MAPIFolder
Dim outNameSpace As Object 'NameSpace
Dim lngAttachment As Long
On Error GoTo err_Outlook_SendEmail
Set objOLApp = CreateObject("Outlook.Application")
Set outNameSpace = objOLApp.GetNamespace("MAPI")
Set outFolder = outNameSpace.GetDefaultFolder(6) 'olFolderInbox=6
Set outItem = objOLApp.CreateItem(0) 'olMailItem=0
outItem.Body = strMsg
outItem.Subject = strSubject
'outItem.To = strTo
Dim strList As String
strList = MakeRecptString("MemberEmail", "Members")
outItem.To = strList
'With outItem.Attachments
' For lngAttachment = LBound(AttachmentList) To UBound(AttachmentList)
' .Add AttachmentList(lngAttachment)
' Next lngAttachment
'End With
outItem.Send
Outlook_SendEmail = True
exit_Outlook_SendEmail:
On Error Resume Next
Set outItem = Nothing
Set outFolder = Nothing
Set outNameSpace = Nothing
Set objOLApp = Nothing
Exit Function
err_Outlook_SendEmail:
Select Case Err.Number
Case 287
'User stopped Outlook from sending email.
MsgBox "Email Cancelled.", vbInformation, "DCDS"
Case Else
MsgBox "Error " & Err.Number & " (" & Err.Description _
& ") in procedure Outlook_SendEmail of Module mod_Utilities"
End Select
Resume exit_Outlook_SendEmail
End Function
---------------------------------------------------
Function MakeRecptString(strField As String, strTable As String, _
Optional varCriteria, Optional varOutFile)
'Purpose : Concantenate list of recipients in a table.
'DateTime : 12/19/2000 08:24
'Author : Bill Mosca
'Return : String for To list.
'Optional : If varOutFile
Dim strRecpt As String
Dim strSQL As String
Dim intFileNum As Integer
Dim strRename As String
Dim db As DAO.Database
Dim rs As DAO.Recordset
strSQL = "Select [" & strField & "] From [" & strTable & "] "
If Not IsMissing(varCriteria) Then
strSQL = strSQL & "WHERE " & varCriteria
End If
Set db = CurrentDb
Set rs = db.OpenRecordset(strSQL)
If rs.EOF Or rs.BOF Then
MsgBox "Email List table not found. Process failed"
Exit Function
End If
With rs
Do While Not .EOF
strRecpt = strRecpt & .Fields(0) & ";"
.MoveNext
Loop
End With
If Not IsMissing(varOutFile) Then
'Create text file for strRecpt.
If Dir(varOutFile) <> "" Then
strRename = InputBox(varOutFile & " already exists. " _
& "Enter a new name for existing file to save it or " _
& "leave box blank to overwrite it.", _
"Rename File?", varOutFile)
If strRename <> "" Then
Name varOutFile As strRename
Else: Kill varOutFile
End If
End If
intFileNum = FreeFile
Open varOutFile For Append As intFileNum
Print #intFileNum, strRecpt
Close intFileNum
End If
Set rs = Nothing
Set db = Nothing
MakeRecptString = strRecpt
End Function
---------------------------------------------------
Unbound form "Send Email to Members" has only one command button "CmdSendEmail"
Private Sub CmdSendEmail_Click()
Dim strRecipients As String
strRecipients = MakeRecptString("MemberEmail", "Members")
Call Outlook_SendEmail(strRecipients, "subject of your email", "Message")
End Sub
Posted by: khalidtanweerburrah@yahoo.com
| Reply via web post | • | Reply to sender | • | Reply to group | • | Start a New Topic | • | Messages in this topic (1) |
Tidak ada komentar:
Posting Komentar