Code: Set objMessage = CreateObject("CDO.Message") Set rsEmail = CurrentDb.OpenRecordset("qryEmailList") rsEmail.MoveFirst Do While Not rsEmail.EOF strEmail = rsEmail.Fields("Email").Value Set objMessage = New CDO.Message strBodyText = "Email body text" objMessage.Subject = "Email subject title" objMessage.From = "firstname.lastname@example.org" objMessage.To = strEmail objMessage.TextBody = strBodyText objMessage.Send rsEmail.MoveNext Loop Set objMessage = Nothing Set rsEmail = NothingAny feedback is greatly appreciated
Code: Private Sub dgmSlanje_Click() Dim OutlookApp As outlook.Application Dim Poruka As outlook.MailItem Dim objDoc As Object Dim OutlookRecip As String Dim strCustomer As String Dim strHTML As String Dim Putanja As String Set OutlookApp = CreateObject("Outlook.Application") Putanja = ctrOft Set Poruka = OutlookApp.CreateItemFromTemplate(ctrOft) strCustomer = "'email@example.com' (firstname.lastname@example.org)" strHTML = Replace(Poruka.HTMLBody, "%subfirstname%", strCustomer) Poruka.Display Poruka.BodyFormat = olFormatHTML Set objDoc = Poruka.GetInspector.WordEditor objDoc.Windows(1).Selection.Find.ClearFormatting objDoc.Windows(1).Selection.Find.Execute strSender 'Poruka.DeferredDeliveryTime = #11/21/2011 10:15:00 PM# Odredjuje vreme slanja If Not ctrPrima.Value = "" Then Poruka.To = ctrPrima End If If Not ctrCc.Value = "" Then Poruka.CC = ctrCc End If If Not ctrBcc.Value = "" Then Poruka.BCC = ctrBcc End If If Not ctrTema.Value = "" Then Poruka.Subject = ctrTema End If Poruka.SendUsingAccount = outlook.Application.Session.Accounts.Item(cmbEAdrese) Set OutlookApp = Nothing Set Poruka = Nothing Set objDoc = Nothing End Sub
Code: Dim datecount As Integer 'assigned the # of days between issue date and end of year Dim expirecount As Integer 'assigned the # of days before card expires Dim issuedate As Date issuedate = Me.frmNameSubApp.Form!appIssueDate datecount = DateDiff("d", issuedate, 12 / 31 / [datepart("yyyy",now)]) If datecount < 60 And datecount > 0 Then expirecount = 365 + datecount Else expirecount = 365 - DateDiff("d", Now, 12 / 31 / [datepart("yyyy",now)]) End If If issuedate = Null Then Text27.Text = Null ElseIf DateDiff("d", issuedate, Now) >= expirecount Then Text27.Text = "Current Card Holder" Else Text27.Text = "Not Current" End If
Code: Private Sub EmOneWay_Click() Dim Notes As Object Dim Maildb As Object Dim objNotesDocument As Object Dim objNotesField As Object Dim mysubject As String Dim mysendto As String Dim myBody As String Dim rs As DAO.Recordset Set rs = Forms!frm_OneWayOffhire!subfrm_OneWay.Form.RecordsetClone Do While Not rs.EOF Dim Cntr As String Dim TS As String Dim Port As String Dim ETA As String Cntr = rs!Container_No TS = rs!Type_Size Port = IIf(IsNull(rs!Port), "", rs!Port) ETA = IIf(IsNull(rs!Arrival), "", rs!Arrival) myBody = myBody & vbCrLf & Cntr & " " & TS & " " & "Port" & " " & Port & " " & "ETA:" & " " & ETA & Chr(13) rs.MoveNext Loop mysubject = "Sub-leased units to be redelivered" mysendto = Me.txtemail 'or you can use Me.txtemail for example Set Notes = CreateObject("Notes.NotesSession") Set Maildb = Notes.GETDATABASE("", "") Call Maildb.OPENMAIL Set objNotesDocument = Maildb.createdocument Set objNotesField = objNotesDocument.appenditemvalue("Subject", mysubject) Set objNotesField = objNotesDocument.appenditemvalue("SendTo", mysendto) Set objNotesField = objNotesDocument.createrichtextitem("Body") Call objNotesDocument.REPLACEITEMVALUE("", , "Body", myBody) Set Workspace = CreateObject("Notes.NotesUIWorkspace") Call Workspace.EDITDOCUMENT(True, objNotesDocument) Dim UIdoc As Object Set UIdoc = Workspace.CURRENTDOCUMENT Call UIdoc.GOTOFIELD("Body") Body1 = "Good Day," & vbCrLf & vbCrLf & "Could you please advise offhire details for the following units:" & vbCrLf & vbCrLf Call UIdoc.InsertText(Body1) 'Insert some carriage returns at the end of the email Call UIdoc.InsertText(vbCrLf & vbCrLf) MsgBox "An email has been generated with Lotus Notes. Please pull up your LotusNotes window to view and send the email. Thank you." End Sub
Code: Private Sub cmdSendEmailToAll_Click() 'Use this code in the build event part of a command button 'to send EMail to everyone in a table having an EMail address. 'This saves you the time and trouble of using contacts in Outlook. 'The first problem I encountered was configuring access to 'talk to' Outlook. 'A helpful person told me to try the following, which I did, and it worked!! 'Open a code window and make sure the following are checked (Tools--->References) 'They are not all checked by default, so you will have to do it. 'Visual Basic for Applications 'Microsoft Access 9.0 Object Library 'OLE automation 'Microsoft ActiveX Data Objects 2.1 Library 'Microsoft DAO 3.6 Object Library 'Change table names and field names in this code to fit your table structure 'Every record in the table you reference must contain an EMail address field. 'In this code, I use a field called EMailAddr. 'Open Outlook and make sure the bcc field is displayed before trying to use the program. 'After opening Outlook, minimize it. The code will run a lot quicker if you don't have to wait for outlook to open. 'If all records in your table do not contain an EMail Address, then 'you should run a MakeTable query first and create a new table. 'I use one field table, with EMailAddr as the field name 'The only records are those having an EMail Address 'Reference the new table in this code. 'The table will be deleted and recreated each time you send an EMail. 'If you do not have to run the MakeTable query (because everyone in your main table has an EMail address) 'comment out the next three lines: Dim strDocName As String strDocName = "tblEmailIncluded" DoCmd.OpenQuery "qryEmailIncluded" On Error GoTo ErrHandle Dim dbs As DAO.Database Dim rst As DAO.Recordset Dim strAddress As String 'this creates the Email addresses Dim strTo As String 'this is needed to populate the TO in the EMail Dim strCC As String 'this is needed to populate the CC in the EMail Dim strBCC As String 'this is needed to populate the BCC in the EMail Dim strSubject As String 'this is needed to populate the SUBJ in the EMail Dim strBody As String 'this is needed to populate a portion of the message text in the EMail 'The following code opens up a record set based on the table called tblVolunteers, which is my main table. 'Replace "tblVolunteers" with the name of the table containing the EMail Addresses. Be sure to include the quotes. Set dbs = CurrentDb Set rst = dbs.OpenRecordset("tblEmailIncluded", dbOpenSnapshot) 'I don't know if the following code works, as I never tested it. If rst.BOF = True And rst.EOF = True Then MsgBox "There must be an error in the query as there are no EMail Addresses listed!" GoTo ErrExit End If With rst .MoveFirst 'go to the first record strAddress = .Fields("EmailAddress").Value 'replace EmailAddress with the name of your EMail field. Be sure to use the quotes strBCC = strAddress .MoveNext 'get all subsequent addresses and separate each with a semi-colon Do While .EOF = False strAddress = .Fields("EmailAddress").Value '*** Replace "EMailAddress" with the name of your field strBCC = strBCC & "; " & strAddress .MoveNext Loop End With strTo = "" 'replace with your own EMail address. It will go into the TO field 'Note: I put all addresses in the BCC field and mail it to myself as 'this will protect the privacy of other peoples mail addresses 'Each person will receive an EMail, without knowing who else got it 'This is done for security reasons strCC = "" 'The CC field will be left blank, unless you put something between the quotes strBCC = strBCC 'All the EMail address, with a semi-colon separating them strSubj = "" 'This will input a generic subject for your EMail. If you don't 'want a generic subject, just use the quotes, with nothing between them strBody = "" 'Chr$(13) will insert a blank line in the subject of your EMail 'Anything between the quotes will be inserted. You can edit, as required before sending 'If you want the subject to be blank, just put the quotes, with nothing between them DoCmd.SendObject , , , strTo, , strBCC, strSubj, , True 'Note the above order. This code fills in the TO, BCC, Subj, and Text blocks of the EMail form ErrExit: Exit Sub ErrHandle: MsgBox Err.Description Resume ErrExit Resume End SubIf anyone can help it would be greatly appreciated. Also If you would like to see how it works let me know.
Code: 'This public sub will send a mail and attachment if neccessary to the 'recipient including the body text. 'Requires that notes client is installed on the system. Public Sub SendNotesMail(Subject As String, Attachment As String, Recipient As String, BodyText As String, SaveIt As Boolean) 'Set up the objects required for Automation into lotus notes Dim Maildb As Object 'The mail database Dim UserName As String 'The current users notes name Dim MailDbName As String 'The current users notes mail database name Dim MailDoc As Object 'The mail document itself Dim AttachME As Object 'The attachment richtextfile object Dim Session As Object 'The notes session Dim EmbedObj As Object 'The embedded object (Attachment) 'Start a session to notes Set Session = CreateObject("Notes.NotesSession") 'Next line only works with 5.x and above. Replace password with your password 'Session.Initialize ("password") 'Get the sessions username and then calculate the mail file name 'You may or may not need this as for MailDBname with some systems you 'can pass an empty string or using above password you can use other mailboxes. UserName = Session.UserName MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf" 'Open the mail database in notes Set Maildb = Session.getdatabase("", MailDbName) If Maildb.ISOPEN = True Then 'Already open for mail Else Maildb.openmail End If 'Set up the new mail document Set MailDoc = Maildb.createdocument MailDoc.Form = "Memo" MailDoc.sendto = Recipient MailDoc.Subject = Subject MailDoc.Body = BodyText MailDoc.SaveMessageOnSend = SaveIt 'Set up the embedded object and attachment and attach it If Attachment "" Then Set AttachME = MailDoc.createrichtextitem("Attachment") Set EmbedObj = AttachME.EmbedObject(1454, "", Attachment, "Attachment") MailDoc.ReplaceItemValue "CreateRichTextItem", ("Attachment") End If 'Send the document MailDoc.PostedDate = Now() 'Gets the mail to appear in the sent items folder MailDoc.Send 0, Recipient 'Clean Up Set Maildb = Nothing Set MailDoc = Nothing Set AttachME = Nothing Set Session = Nothing Set EmbedObj = Nothing End SubI then call the following:
Code: Sub QtrEmail() DoCmd.OutputTo acOutputReport, "rptAMQtrUpt", _ acFormatRTF, "J:MFGShopAMQtrUpt.rtf", False Dim stTomb As String stTomb = "email@example.com" Call SendNotesMail("Quarterly Update", "J:MFGShopAMQtrUpt.rtf", stTomb, "Report attached", True) End SubI gather I need to declare my "BodyText" as a variable.... I'm just not certain what all I need to do to get the information emailed without an attachment. Can anyone point me in the right direction? Thanks
Code: Me.eSSS.SetFocus Dim esssContent As String esssContent = Me.eSSS.Text Application.FollowHyperlink "mailto:?body=" & esssContentI want to let the body text to not be limited by size and I want to be able to preserve and hard returns that were in the original field.
Code: ="Greetings, You are recieving this notification because you are listed as the owner for an AFE still in process:" & Chr(13) & Chr(10) & " " & Chr(13) & Chr(10) & " " & [ProjectDef] & " - " & [ProjectName] & " " & Chr(13) & Chr(10) & " " & Chr(13) & Chr(10) & " In order to facilitate new reporting requirements I will be needing a planned spend on all projects in process for Q2,Q3, and Q4 of this year. Also, if any spend will be pushed to next year, please indicate that as '2014 and beyond'. Please furnish all of the information on the attached spreadsheet. If the project listed is completed, please reply to this message with the MONTH/YEAR of completion and that will close your responsibility. If you have multiple projects, feel free to consolidate them on the spreadsheet." & Chr(13) & Chr(10) & " " & Chr(13) & Chr(10) & " Your reply is appreciated BY TUESDAY, APRIL 2nd 2013. If you have any questions, feel free to eMail me any time. " & Chr(13) & Chr(10) & " " & Chr(13) & Chr(10) & " Regards," & Chr(13) & Chr(10) & " " & Chr(13) & Chr(10) & " (closing signature)"This is my current label I have that is mapped to the email body. As you can see it is rather messy. I have used a utility like this with Apple in a Filemaker database that could do mass emails and it was MUCH easier. I could basically type at will and simply insert a variable wherever needed. IE
Code: (Greetings [customer], your order number is [order_no] and was shipped out on [ship_date])Is there any such easier way to do this without having to submit to the draconian syntax in Text Boxes in Access?
Code: Private Sub SendEmail2_Click() Dim EmailApp, NameSpace, EmailSend As Object Dim strTitle, strFn, strLN, strBody As String Set EmailApp = CreateObject("Outlook.Application") If EmailApp Is Nothing Then Set EmailApp = CreateObject("Outlook.Application") Set NameSpace = EmailApp.GetNamespace("MAPI") Set EmailSend = EmailApp.CreateItem(0) strTitle = Me![Title] strFn = Me![First Name] strLN = Me![Last Name] strBody = "Dear " & strTitle & " " & strFn & " " & strLN & "," & Chr(13) & Chr(13) strBody = strBody & "Warm greetings!" & Chr(13) & Chr(13) strBody = strBody & "My name is Lala." & Chr(13) strBody = strBody & "I live in Lulu." strBody = strBody & "Shipping method: " & [Position] & Chr(13) strBody = strBody & "Date shipped: " & [Birthdate] & Chr(13) strBody = strBody & "Tracking / Confirmation number: " & [ProfileID] & Chr(13) strBody = strBody & "Sincerely," & Chr(13) & Chr(13) strBody = strBody & "Acme Corporation" If IsNull([Email]) Or ([Email]) = "" Then MsgBox "There is no E-mail address entered for this person!" Exit Sub Else With EmailSend .Subject = "Warm Greetings!" .To = Me.Email '.CC = "" '.From = "firstname.lastname@example.org" .Body = strBody '.Attachments.Add "C:attachment.txt" '.Attach = strFilePath & "" & strFileName '.AttachFile strFilePath & "" & strFileName, strFileName .Display End With End If Set EmailApp = Nothing Set NameSpace = Nothing Set EmailSend = Nothing End SubWhat I would like to do is to get the message body from a textfile instead of entering it as a string directly into the code.