I am trying to create a taskmangement in Outlook with Custom Forms.
The custom form has a button (sendtask) a field assignto and a hidden textbox that copies the value from assignto to add to variable (myvalue) to include in To.
A user can assign a task with the assignto field. But with this way I can't send an email to multiple recipients.
Sub sendtask_click()
Set objPage = Item.GetInspector.ModifiedFormPages("Assign Task")
Set objControl = objPage.Controls("TextBox1")
Set oMsg = Application.CreateItem(olMailItem)
Set objNS = oMsg.Session
MyValue= objControl.Text
With oMsg
.To(MyValue)
.Subject = "New Task Assign"
.HTMLBody = "<HTML><BODY>You have new Task assign by " & _
objNS.CurrentUser.Name & " <h1>" & Item.Subject & _
"</h1><br/>" & "Description <br/>" & Item.Body & _
"<br/><br/>" & "Start Date:" & Item.StartDate & _
"<br/>" & "Due Date:" & Item.DueDate & "</BODY></HTML>"
.Send
End With
End Sub
How can I send an email to multiple recipients?
Did you try
With oMsg
.To = Join(Array("someone#here.com", MyValue),"; ")
'... rest of your with block code
End With
Related
I have everything working to send an email via an Access command button. However, the displayed email address is incorrect.
Private Sub cmdSendEmail_Click()
Dim EmailApp, NameSpace, EmailSend As Object
Set EmailApp = CreateObject("Outlook.Application")
Set NameSpace = EmailApp.GetNamespace("MAPI")
Set EmailSend = EmailApp.CreateItem(0)
EmailSend.To = [emailadd] '[emailadd] is the field on the form where the button is located
EmailSend.Subject = [Forms]![WorkordersVR]![Project] & " - " & [Forms]![WorkordersVR]![JobNumber]
EmailSend.Body = "Hello," & vbCrLf & vbCrLf & _
"The project" & " " & [Forms]![WorkordersVR]![Project] & " " & "is ready for pickup." & vbCrLf & vbCrLf & _
"Thank you!" & vbCrLf & vbCrLf & _
"Person sending email here" & vbCrLf & _
EmailSend.Display
Set EmailApp = Nothing
Set NameSpace = Nothing
Set EmailSend = Nothing
End Sub
What ends up in the displayed email To is:
"fred#aplace.com#fred#aplace.com#"
How do I get fred#aplace.com?
You can use string functions available in VBA to get a substring until the # symbol in the string. For example, the InStr function returns a number specifying the position of the first occurrence of one string within another.
Also I'd suggest using the Recipients property of the MailItem class which returns a Recipients collection that represents all the recipients for the Outlook item. Then I'd suggest using the Recipient.Resolve method which attempts to resolve a Recipient object against the Address Book.
For example:
Sub CreateStatusReportToBoss()
Dim myItem As Outlook.MailItem
Dim myRecipient As Outlook.Recipient
Set myItem = Application.CreateItem(olMailItem)
Set myRecipient = myItem.Recipients.Add("email")
myRecipient.Resolve
If(myRecipient.Resolved) Then
myItem.Subject = "Status Report"
myItem.Display
End If
End Sub
I need my Access Database to create emails that are sent at the press of a button.
This works for Outlook, and I adapted the code for Gmail.
I don't want to hardcode the email username and password. I want to pick it up from a combobox on the main form.
I get the error
Private Sub Email_Allocation_List_Click()
Dim newMail As CDO.Message
Dim mailConfiguration As CDO.Configuration
Dim fields As Variant
Dim msConfigURL As String
On Error GoTo errHandle
Set newMail = New CDO.Message
Set mailConfiguration = New CDO.Configuration
mailConfiguration.Load -1
Set fields = mailConfiguration.fields
With newMail
.Subject = "subject"
.From = [Forms]![Main form]![EmailAddress].Column(1)
.To = "email address"
.CC = "email address"
.BCC = ""
.TextBody = "Hello, " & vbNewLine & vbNewLine & _
"Please find attached todays list of lines to be allocated." & _
vbNewLine & vbNewLine & "Kind Regards." & vbNewLine & vbNewLine & "Carly"
.AddAttachment "file location"
End With
msConfigURL = "http://schemas.microsoft.com/cdo/configuration"
With fields
.Item(msConfigURL & "/smtpusessl") = True
.Item(msConfigURL & "/smtpauthenticate") = 1
.Item(msConfigURL & "/smtpserver") = "smtp.gmail.com"
.Item(msConfigURL & "/smtpserverport") = 465
.Item(msConfigURL & "/sendusing") = 2
.Item(msConfigURL & "/sendusername") = [Forms]![Main form]![EmailAddress].Column(1)
.Item(msConfigURL & "/sendpassword") = [Forms]![Main form]![EmailAddress].Column(2)
.Update
End With
newMail.Configuration = mailConfiguration
newMail.Send
MsgBox "E-Mail has been sent", vbInformation
exit_line:
'// Release object memory
Set newMail = Nothing
Set mailConfiguration = Nothing
Exit Sub
errHandle:
MsgBox "Error: " & Err.Description, vbInformation
GoTo exit_line
End Sub
I checked the comboboxes work with a text box.
After a lot of messing around, you are correct, the code is fine - and it was reading the contents of the combo box correctly - however GMail didn't accept the log in information if there was a capital letter on the email address!!! Now working beautifully.
This question already has answers here:
How to add default signature in Outlook
(15 answers)
Closed 6 years ago.
I have completed this code to populate the body of an Outlook email, however, I do not know how I can use my existing signature block already created in Outlook. When I create a new, reply or forward email, my signature is there, but when I create the email with this code it does not appear. What I'm trying to accomplish here is to have my signature (or any signature for that matter) appear into the email created by this code.
Private Sub emailbutton_Click()
'No-option email sending
Dim OL As Object
Dim EmailItem As Object
Dim Doc As Document
Application.ScreenUpdating = False
Set OL = CreateObject("Outlook.Application")
Set EmailItem = OL.CreateItem(olMailItem)
Set Doc = ActiveDocument
If VName.Value = "" Then
Doc.SaveAs ("Quotation_Blank 2016")
Else
Doc.SaveAs2 ("QFORM" & "_" & JNumber.Value & "_" & VName.Value)
End If
With EmailItem
.Subject = "QFORM" & "_" & JNumber.Value & "_" & VName.Value
'HTMLbody
msg = "<b><font face=""Times New Roman"" size=""3"" color=""blue"">INTEGRATED ASSEMBLY </font></b><br>" _
& " 1200 Woodruff Rd.<br>" _
& " Suite A12<br>" _
& " Greenville, SC 29607<br><br>" _
& "We have recently released subject project, which will contain assemblies to be outsourced. You have been selected to build these assemblies according to the attachment.<br><br>" _
& "As part of this process, please review the quotion form attached and inidcate your acceptance. If adjustments and-or corrections are required please feel free to contact us for quick resolution.<br><br>" _
& "<b><font face=""Times New Roman"" size=""3"" color=""Red"">NOTE: </font></b>" _
& "The information on attached quotation form is not a contract and only an estimate of predetermined costs per hourly rate for outsource assemblies. <br><br>" _
& "*******For your records you may wish to print out the completed quote form. <br><br>" _
& "Thank you, <br><br>" _
& "<b>HARTNESS INTERNATIONAL </b><br>" _
& "H1 Production Control" & vbNewLine & Signature
.HTMLBody = msg
If VName.Value = "INTEGRATED ASSEMBLY" Then
.To = "XXX.com;"
.CC = "XXX.com;" & "XXX.com;"
.Importance = olImportanceNormal 'Or olImportanceHigh Or olImportanceLow
.Attachments.Add Doc.FullName
.Display
ElseIf VName.Value = "LEWALLEN" Then
.To = "XXX.com;"
.CC = "XXX.com;" & "XXX.com;"
.Importance = olImportanceNormal 'Or olImportanceHigh Or olImportanceLow
.Attachments.Add Doc.FullName
.Display
End If
End With
Application.ScreenUpdating = True
Set Doc = Nothing
Set OL = Nothing
Set EmailItem = Nothing
End Sub
I think you need to call the .HTMLBody again after you insert msg.
So for example:
.HTMLBody = msg & .HTMLBody
Should get the signature. I'm not deep enough into programming to know why though.
Do you have Option Explicit set in your module?
I don't see where you've set Signature or declared it so it's probably empty and not giving you an error message.
I think you need to retrieve it first by pulling in the blank Body
Something like this should work
With EmailItem
.Display
signature = .body
.Subject = "QFORM" & "_" & JNumber.Value & "_" & VName.Value
' and so on ..
`
The code was successful with inputting a with statement to display the EmailItem - along with recalling .HTMLBody following the msg.. Please see full code below.
Private Sub emailbutton_Click()
'No-option email sending
Dim OL As Object
Dim EmailItem As Object
Dim Doc As Document
Application.ScreenUpdating = False
Set OL = CreateObject("Outlook.Application")
Set EmailItem = OL.CreateItem(olMailItem)
Set Doc = ActiveDocument
With EmailItem
.Display
End With
Signature = EmailItem.body
With EmailItem
.Subject = "QFORM" & "_" & JNumber.Value & "_" & VName.Value
'HTMLbody
msg = "<b><font face=""Times New Roman"" size=""4"" color=""blue"">INTEGRATED ASSEMBLY </font></b><br>" _
& " 1200 Woodruff Rd.<br>" _
& " Suite A12<br>" _
& " Greenville, SC 29607<br><br>" _
& "We have recently released subject project, which will contain assemblies to be outsourced. You have been selected to build these assemblies according to the attachment. <br><br>" _
& "As part of this process, please review the quotation form attached and indicate your acceptance. If adjustments and-or corrections are required, please feel free to contact us for quick resolution. <br><br>" _
& "<b><font face=""Times New Roman"" size=""4"" color=""Red"">NOTE: </font></b>" _
& "The information on attached quotation form is not a contract and only an estimate of predetermined costs per hourly rate for outsource assemblies. <br><br>" _
& "*******For your records you may wish to print out the completed quote form. <br><br>" _
& "Thank you, <br><br>" _
& "<b>HARTNESS INTERNATIONAL </b><br>" _
& "H1 Production Control <br>" _
& vbNewLine & Signature
.HTMLBody = msg & .HTMLBody
If VName.Value = "INTEGRATED ASSEMBLY" Then
.To = "ryan#integratedassembly.com;"
.CC = "jfournier#hartness.com;" & "jmarshone#hartness.com;"
.Importance = olImportanceNormal 'Or olImportanceHigh Or olImportanceLow
.Attachments.Add Doc.FullName
.Display
ElseIf VName.Value = "LEWALLEN" Then
.To = "jessica.andrews#patriot-automation.com;"
.CC = "jfournier#hartness.com;" & "jmarshone#hartness.com;"
.Importance = olImportanceNormal 'Or olImportanceHigh Or olImportanceLow
.Attachments.Add Doc.FullName
.Display
End If
End With
If VName.Value = "" Then
Doc.SaveAs ("Quotation_Blank 2016")
Else
Doc.SaveAs2 ("QFORM" & "_" & JNumber.Value & "_" & VName.Value)
End If
Application.ScreenUpdating = True
Set Doc = Nothing
Set OL = Nothing
Set EmailItem = Nothing
End Sub
I'm trying to create a VBA macro in Outlook that when an email from a certain address is received, ammend the original email with a reply template and fwd it to a DL .
So far this is what I got :
Sub B1(Item As Outlook.MailItem) 'Reply with template
Dim oRespond As Outlook.MailItem
'This sends a response back using a template
Set oRespond = Application.CreateItemFromTemplate("D:\Appdata1\Roaming \Microsoft\Templates\Request.oft")
With oRespond
.Recipients.Add Item.SenderEmailAddress
.Subject = "Request for Approval - " & Item.Subject
.HTMLBody = oRespond.HTMLBody & vbCrLf & _
"---- original message below ---" & vbCrLf & _
Item.HTMLBody & vbCrLf
.Send
End With
Set oRespond = Nothing
End Sub
This doesn't seem to work at all, ha! It worked for a while except the ammending part, then I started tinkering but after that it stopped working altogether.
Try Deleting the rule and recreate it...
Code Tested on 2010 Outlook
Option Explicit
Sub B1(Item As Outlook.MailItem) 'Reply with template
Dim oRespond As Outlook.MailItem
'This sends a response back using a template
Set oRespond = Application.CreateItemFromTemplate("D:\Appdata1\Roaming\Microsoft\Templates\Request.oft")
With oRespond
.Recipients.Add Item.SenderEmailAddress
.Subject = "Request for Approval - " & Item.Subject
.HTMLBody = oRespond.HTMLBody & vbCrLf & vbCrLf & _
"---- original message below ---" & vbCrLf & Item.HTMLBody & vbCrLf
.Display
' .Send
End With
Set oRespond = Nothing
End Sub
When I complete a piece of work I email it to certain people. It depends on the work who gets it.
If any person in the list leaves, changes job or has an email change the code will bug out saying
Run Time error -2147467259(80004005), Outlook Does Not Recognise One Or More Names
If I manually copy the email addresses in the list and pop them into Outlook and send I'll get an email back saying the user doesn't exist or has been changed.
I have tried On Error Resume Next and On Error Goto. I have added MS Outlook 14.0 Object Libary, SharePoint Social Provider, Social Provider Extensibility and Outlook View control from the references.
The code bugs out on the .send
Sub EMailer()
Application.ScreenUpdating = False
strfilepath = "\\DFZ70069\Data\199711009\workgroup\Res Plan Team\Performance Management\Specialised Reporting\Debit & Credit Reporting\Masters\Sent Reports\"
strArea = "Recipients" '..........................................................................................
'Get list of recipients for email
For Each cell In Worksheets("EMails").Range(sRange)
If cell.Value = "" Then GoTo Continue
strmaillist = strmaillist & cell.Value + ";"
Continue:
Next
[B1].Value = strmaillist
If bMyEmail = True Then
strmaillist = strmaillist & MyEmailAddress
End If
'Display email list
Dim AckTime As Integer, InfoBox As Object
Set InfoBox = CreateObject("WScript.Shell")
AckTime = 1
Select Case InfoBox.Popup("Sending " & sReportName & " emails to " & vbNewLine & strArea, _
AckTime, "Message Box", 0)
Case 1, -1
End Select
'SEND EMAIL
'set up Body of email............
strbody = "Please find attached " & sReportName & " Report " & " _" & strDate & vbLf & vbLf & _
strComments & vbLf & _
strComments2 & vbLf & _
"" & vbLf & _
eMailName & vbLf & _
"MI & Performance Reporting Team" & vbLf & _
sline2 & vbLf & _
sline3 & vbLf & vbLf & _
sLine4
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.to = strmaillist
.CC = ""
.BCC = ""
.Subject = sReportName & " Report " & strDate
.HTMLBody = "Set to HTML" & vbLf & vbLf & ""
.Body = strbody
.Attachments.Add (strfilepath & sTemplateName)
.send ' bugs out here
End With
Set OutMail = Nothing
Set OutApp = Nothing
ThisWorkbook.Activate
Sheets("Sheet1").Select
Application.ScreenUpdating = True: Application.ScreenUpdating = False
Sheets("Sheet1").Select
Range(sRange2).Value = sConclusion '.
Application.ScreenUpdating = True: Application.ScreenUpdating = False
End Sub
You can try to check the validity of the recipient before sending, by using the .Resolve method of the Recipient object. Only valid recipients can be kept in the Recipient list of the mail item.
You might try this:
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.Subject = sReportName & " Report " & strDate
.HTMLBody = "Set to HTML" & vbLf & vbLf & ""
.Body = strbody
.Attachments.Add (strfilepath & sTemplateName)
For Each cell In Worksheets("EMails").Range(sRange)
If cell.Value <> "" Then
set r = .Recipients.Add(cell.value)
If Not r.Resolve then r.Delete '<~~ Removes invalid recipients
End If
Next
.send
End With