I send an email with VBA. A classification is popped up for each email and it needs to be set by hand. I am trying to work around this in the code.
I found a code to send emails: Mail a message with outlook via VBA.
After fixing few things, the following code is working.
Sub sendEmail()
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
'Working in Office 2000-2016
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Application.ScreenUpdating = False
Application.EnableEvents = False
Set OutApp = CreateObject("Outlook.Application")
On Error GoTo cleanup
For Each cell In Columns("B").Cells.SpecialCells(xlCellTypeConstants)
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = cell.Value
.Subject = "Reminder"
.Body = "Dear " & Cells(cell.Row, "A").Value _
& vbNewLine & vbNewLine & _
"Please Finish your course " & Cells(cell.Row, "C") & _
" before expiry date."
.Send 'Or use Display
End With
On Error GoTo 0
Set OutMail = Nothing
Next cell
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub
The problem is that after sending emails from the list to for example 10 persons, I need to click on classification pop up 10 times.
I found this: How to save workbook and handle TITUS (or any other document classification add-in) popup?
I tried .EnableEvents = False before .Send. I am not sure if this does serve me.
How to use this in my case? Is it doable to disable it, work around it, or even set a classification within the code?
There is a workaround, but you have to do it in Outlook Developer itself. You can set up an event handler in Outlook which triggers a macro. So, in this case, Outlook could watch for a message to be created with a specific subject line (as an example), and THAT would trigger the script below, which bypasses TITUS.
'Sets Titus Mail settings and sends mail
With AOMailMsg
objMsg.ItemProperties.Add("ABCDE.Registered To", olText) = "My Companies"
objMsg.ItemProperties.Add("ABCDE.Classification", olText) = "Internal"
objMsg.UserProperties.Add("ABCDE.Registered To", olText) = "My Companies"
objMsg.UserProperties.Add("ABCDE.Classification", olText) = "Internal"
objMsg.UserProperties.Add("TITUSAutomatedClassification", olText) = _
"TLPropertyRoot=ABCDE;.Registered To=My Companies;.Classification=Internal;"
objMsg.Send
End With
Related
I want to send an email via Outlook with workbook attached.
The "To" and "CC" fields are not populating, which results in the email not sending.
The "To" and "Cc" fields will change each time the Excel workbook is used so need to use data in H16 and H19 to populate who the email is to be sent to.
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
strbody = "<Font Size=2 Font Face=Verdana> Hi,<br><br>" & _
"Please review and approve.<br>"
On Error Resume Next
With OutMail
.Display
.To = ActiveSheet.Range("H16")
.CC = ActiveSheet.Range("H9")
.BCC = ""
.Subject = "[APPROVAL REQUIRED]"
.HTMLBody = strbody & "<br>" & .HTMLBody
.Recipients.ResolveAll
.Attachments.Add Application.ActiveWorkbook.FullName
.Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
Without On Error Resume Next I get:
Run-time error '-2147417851 (80010105)': Method 'To' of object'_MailItem' failed
You now understand why:
On Error Resume Next
: : : :
On Error GoTo 0
is never used like this. Used like this it conceals all errors so is only used by people who like mysterious failures. If you would like, I will add a section explaining how On Error Resume Next is supposed to be used.
"Run-time error '-2147417851 (80010105)': Method 'To' of object'_MailItem' failed" is not the most helpful of error messages. All you know something about ActiveSheet.Range("H16") is not compatible with .To.
I would add:
Debug.Print ActiveSheet.Name
Is the ActiveSheet the one you want? ActiveSheet is a property to avoid unless you really need a different active worksheet every time you run the macro. Worksheets("Email Data") is much safer and is helpful for a future maintenance programmer.
If it is the correct worksheet, what is the value of ActiveSheet.Range("H16")? Is it a string or something that can be converted to a string automatically? Try:
Dim StrTemp As String
StrTemp = ActiveSheet.Range("H16").Value
Debug.Print StrTemp
.To = StrTemp
I will be surprised if this does not reveal a problem. Please report what happens if you need further help.
I have an excel spreadsheet for permits, and one column is their expiration dates. My boss wants to be emailed about the permits that expire in the next 2 weeks. How can I use visual basic to tell Outlook to send an email each time he opens the excel spreadsheet?
This is for a spreadsheet I set up, permit names are in column A, dates are in column J.
Sub Mail_small_Text_Outlook()
Dim OutMail As Object
Dim strbody As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
strbody = "Hi there" & vbNewLine & vbNewLine & _
"Cell A1 is changed" & vbNewLine & _
"This is line 2" & vbNewLine & _
"This is line 3" & vbNewLine & _
"This is line 4"
On Error Resume Next
With OutMail
.To = "ron#debruin.nl"
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.Body = strbody
'You can add a file like this
'.Attachments.Add ("C:\test.txt")
.Display 'or use .Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
I may have to use a button to run the program, but I'm not sure if it is possible to schedule emails.
It appears that you have not dimmed OutApp as an object.
Once that is done add a loop examining the expiration dates and adding the specific cells to a dynamic array, re-dimming the array with each iteration. Finally each license on the array will need to be added to a text string that can then be added to the body of the email you are creating above....
Once you have all the above working as you would like, you will want to tie the whole operation to the Workbook Open event.
In the VBE, open This Workbook...
Then use the drop-down menus to select the Workbook and Open Event and add your code and save.
I have the below macro which will scan an excel file with manager emails down Col B. For each manager, an email will be drafted/an excel file attached/ and sent automatically. I have been able to test this and it is working fine when drafting 50 - 100.
My concern is, 50 - 100 emails does not seem like a good indicator of knowing if this will work fine when sending 5,000 emails.
Am I at risk of this freezing or other issues when running this on actual file with 5,000 emails?
Sub CorpCard()
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
On Error GoTo cleanup
For Each cell In Columns("B").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "?*#?*.?*" And LCase(Cells(cell.Row, "C").Value) = "yes" Then
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.SentOnBehalfOfName = "urdearboy#hi.com"
.to = cell.Value
.Subject = "Your Employees With A Corporate Credit Card - EID - " & Cells(cell.Row, "D").Value
.Body = "Hi " & Cells(cell.Row, "A").Value & "," _
'Body to be patsed here
strLocation = "C:\Users\urdearboy\Desktop\File Name " & Cells(cell.Row, "D").Value & ".xlsx"
.Attachments.Add (strLocation)
.Send
End With
On Error GoTo 0
Set OutMail = Nothing
End If
Next cell
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub
Would it be a good idea to house my For Each loop inside another loop something like For i = 1 to 5000 Step 50 and then add Do Events before starting the actual loop to give my computer some time to catch up before proceeding with the next 50 emails? I'm not exactly sure if this is in the scope of Do Events though. I can also provide computer specs if necessary.
This should work fine for larger files. With that number of emails to send though, your run time could easily be over an hour. A good idea might be to raise some flag in the error handler in case it does encounter an issue. Maybe something like:
if Err then
Msgbox "Error Encountered at Row " & cell.row
end if
right underneath the with-block.
I've excel sheet (invoice) , i am updating client invoice and bill status regularly , i need to send remainder email to my client before bill reaches credit date (before 7 days) (only Pending bills), i am manually sending the email so far to my clients,
is there any option that automated email can send from excel before due date reaches (7days before and 3 days before) , could any one help me
Email Format
Excel Sheet Sample
This should do what you want!
To run a macro automatic when you manual change a specific cell you can use the Change event in a worksheet module.The example on this page use Cell A1 and will run the macro if the cell value >200.
1) Right click on a sheet tab and choose view code
2) Paste the event below in the sheet module.
3) Alt-q to go back to Excel
Note: Change YourMacroName to the name of your macro in the code.
If you want the code to work for another cell or more cells you can change the range in the event.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Application.Intersect(Range("A1"), Target) Is Nothing Then
If IsNumeric(Target.Value) And Target.Value > 200 Then
Call YourMacroName
End If
End If
End Sub
Example mail macro
Test this example macro to create/display a Outlook mail with a small text message.
You must copy this macro in a standard module and not in the worksheet module, see this page how.
Note: I use .Display in the code to display the mail, you can change that to .Send
Do not forget to change Call YourMacroName to Call Mail_small_Text_Outlook in the Change event.
Sub Mail_small_Text_Outlook()
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
'Working in Excel 2000-2016
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
strbody = "Hi there" & vbNewLine & vbNewLine & _
"Cell A1 is changed" & vbNewLine & _
"This is line 2" & vbNewLine & _
"This is line 3" & vbNewLine & _
"This is line 4"
On Error Resume Next
With OutMail
.To = "ron#debruin.nl"
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.Body = strbody
'You can add a file like this
'.Attachments.Add ("C:\test.txt")
.Display 'or use .Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
http://www.rondebruin.nl/win/s1/outlook/bmail9.htm
I'm trying to figure out a way to detect whether or not the user clicks "Send" in the Outlook application that is displayed. I've tried reading the value of .Display similarly to how one would detect user input when using the FileDialog application (someInt = .Show), to no avail. I can't find any documentation on the Outmail Application, so any help would be greatly appreciated.
Set olApp = CreateObject("Outlook.Application")
Set Outmail = olApp.CreateItem(olMailItem)
With Outmail
.To = clientEmail
.CC = projectManagerEmail
.BCC = ""
.Subject = projectName & " (PO # " & poNumber & ", Job #" & projectNumber & ") - " & fileType & " (" & fileName & ")"
.Attachments.Add ActiveWorkbook.Path & "\" & fileType & "\" & folderName & "\" & fileName & ".pdf"
.Display
.Save
End With
I believe you need to intercept the Send operation in Outlook.
In Outlook, go to VBA Editor (Alt-F11), then paste below into the ThisOutlookSession under Microsoft Outlook Objects.
Make sure your operations works in Outlook, then close Outlook. You may have to Sign the code, change Macro Security Settings depending on your environment. Value of Cancel is what determines if the user has clicked Send (e.g. clicked -> Cancel=False).
Since there is no direct way to get the value of Cancel, may be you have to create a unique text file in local temp folder and pick it up in Excel to indicate it is Sent.
Private Sub Application_ItemSend(ByVal oItem As Object, Cancel As Boolean)
' Add Operations or Sub calls here
MyCheck01 oItem, bCancel
End Sub
Private Sub MyCheck01(ByVal oItem As Object, Cancel As Boolean)
' Do operations here. If Send is to be aborted, set Cancel to True.
End Sub
You will also need to define this olMailItem in Excel (Const olMailItem = 0).