I am trying to save the digital signature of the currently opened mail item.
Now I realize that Outlook prevents access to encrypt/sign a new email programmatically. Here I am focused on messages which have been received.
So far, I am just able to use the MessageClass property to detect a signed email.
Function GetCurrentItem() As Object
Dim objApp As Outlook.Application
Set objApp = CreateObject("Outlook.Application")
On Error Resume Next
Select Case TypeName(objApp.ActiveWindow)
Case "Explorer"
Set GetCurrentItem = objApp.ActiveExplorer.Selection.Item(1)
Case "Inspector"
Set GetCurrentItem = objApp.ActiveInspector.CurrentItem
Case Else
' anything else will result in an error, which is
' why we have the error handler above
End Select
Set objApp = Nothing
End Function
Sub DoExport()
Set CurrentItem = GetCurrentItem()
If CurrentItem.MessageClass = "IPM.Note.SMIME.MultipartSigned" Then
MsgBox CurrentItem.MessageClass
End If
End Sub
Messageclass always seems to be "IPM.Note" even on encrypted and signed mail.
I use this code to read who signed the mail.
Set PropertyAccessor = mailitem.PropertyAccessor
If PropertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00020328-0000-0000-C000-000000000046}/9104001f") <> "" Then
END
End If
Related
I have code that reads mail to generate a task with the mail's content.
In a few cases this hits a problem, when reading the RTFbody from the mail, saying "not implemented".
Can I test against this? Like WHEN IS NULL ... which checks if a variable has appropriate content.
Sub CreateTempTaskFromMail()
Dim oMail As Outlook.MailItem
Set oMail = ActiveInspector.CurrentItem
Dim s, sNr As String
s = oMail.subject
Dim oTask As Outlook.TaskItem
Set oTask = CreateTaskWithTempFolder(s, False) ' Function creating and returing task
oTask.RTFBody = oMail.RTFBody
End sub
I tried to test several ways if RTFbody has a problem. All of these approaches throw an error.
If oMail.RTFBody Is Nothing Then Stop
If IsError(oMail.RTFBody) Then Stop
If IsMissing(oMail.RTFBody) Then Stop
If IsEmpty(oMail.RTFBody) Then Stop
If there is absolutely no real solution then
Option Explicit
Sub CreateTempTaskFromMail()
Dim oObj As Object
Dim oMail As mailItem
Dim oTask As TaskItem
Dim s As String
Set oObj = ActiveInspector.currentItem
If oObj.Class = olMail Then
Set oMail = oObj
s = oMail.subject
Set oTask = CreateTaskWithTempFolder(s, False) ' Function creating and returing task
' If you absolutely cannot determine the problem
' https://excelmacromastery.com/vba-error-handling#On_Error_Resume_Next
On Error Resume Next
oTask.RTFBody = oMail.RTFBody
If Err <> 0 Then
Debug.Print "Error was bypassed using a technique that is to be avoided."
Exit Sub
End If
' Consider mandatory AND as soon as possible
On Error GoTo 0
oTask.Display
Else
Debug.Print "not a mailitem"
End If
End Sub
Before accessing the RTFBody property in the code I'd suggest checking the item's type first to make sure such property exists for a specific item type:
If TypeOf item Is MailItem Then
' do whatever you need with RTFBody here
End If
Or
If TypeName(item) = "MailItem" Then
' do whatever you need with RTFBody here
End If
If you are using Office 2016 product, you should update office. It is early office 2016 build's bug.
Been trying various approaches from either experimenting or googling but cant seem to figure this one out.
In this code, when the email is being sent from the explorer via a reply, it only grabs the body from below what is "being sent now" instead of a lof it. I assume there is an object I haven't been able to find intuitively that holds this but I cant seem to figure out.
Anyone know what I might be over looking?
Code used
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim prompt As String
Dim msg As MailItem
Set msg = GetCurrentItem()
prompt = msg.Body
MsgBox prompt
End Sub
Function GetCurrentItem() As Object
Dim objApp As Outlook.Application
Set objApp = Application
On Error Resume Next
Select Case TypeName(objApp.ActiveWindow)
Case "Explorer"
Set GetCurrentItem = objApp.ActiveExplorer.Selection.Item(1)
Case "Inspector"
Set GetCurrentItem = objApp.ActiveInspector.CurrentItem
End Select
Set objApp = Nothing
End Function
I have the following code from some blog that inserts HTML from the clipboard into an outlook email.
Sub PrependClipboardHTML()
Dim email As Outlook.MailItem
Dim cBoard As DataObject
Set email = Application.ActiveInspector.CurrentItem
Set cBoard = New DataObject
cBoard.GetFromClipboard
email.HTMLBody = cBoard.GetText + email.HTMLBody
Set cBoard = Nothing
Set email = Nothing
End Sub
It works great except that the email has be in its own window (i.e. popped-out) otherwise it will fail.
I was looking around on the documentation and found Application.ActiveExplorer.ActiveInlineResponse here.
However the documentations says that it is read-only, and indeed it does not work. Is there way to get a writable version of the inline response?
It works great except that the email has be in its own window (i.e. popped-out) otherwise it will fail.
That is because you have the following statement in the code:
Set email = Application.ActiveInspector.CurrentItem
However the documentations says that it is read-only, and indeed it does not work.
Try to use the following code instead:
Set email = Application.ActiveExplorer.ActiveInlineResponse
The ActiveInlineResponse property is read-only, but not the object's properties you are going to use. That means you can't set another mail item to the inline response, but will be able to set up properties of the retrieved item.
Maybe you're trying to work with ActiveExplorer + Selection.Item Method (Outlook)
Example
Option Explicit
Public Sub Example()
Dim email As Outlook.MailItem
Set email = Application.ActiveExplorer.Selection.Item(1)
Debug.Print email.Subject ' print on immediate window
End Sub
Or Work with both opened and selected items
Function GetCurrentItem() As Object
Dim objApp As Outlook.Application
Set objApp = Application
On Error Resume Next
Select Case TypeName(objApp.ActiveWindow)
Case "Explorer"
Set GetCurrentItem = objApp.ActiveExplorer.Selection.Item(1)
Case "Inspector"
Set GetCurrentItem = objApp.ActiveInspector.CurrentItem
End Select
Set objApp = Nothing
End Function
You cannot concatenate two HTML strings and expect a valid HTML back. The two must be merged.
That being said, use Word Object Model to paste from the clipboard:
Application.ActiveEXplorer.ActiveInlineResponseWordEditor.Application.Selection.Paste()
I am attempting to add convenience when adding notes to emails in Outlook.
My plan is to take my current procedure, which adds the notes to the selected email (as an attachment), and have it call a procedure which will set a UserProperty on the MailItem object so that I can easily see which emails have notes attached by adding a custom column to my email list view.
From scouring the internet I have pieced together the following.
Option Explicit
Public Sub MarkHasNote()
Dim Selection As Outlook.Selection
Dim UserDefinedFieldName As String
Dim objProperty As Outlook.UserProperty
Dim objItem As MailItem
UserDefinedFieldName = "Note"
Set objItem = GetCurrentItem()
Set objProperty = objItem.UserProperties.Add(UserDefinedFieldName, Outlook.OlUserPropertyType.olYesNo, olFormatYesNoIcon)
objProperty.Value = True
End Sub
Function GetCurrentItem() As Object
Dim objApp As Outlook.Application
Set objApp = Application
On Error Resume Next
Select Case TypeName(objApp.ActiveWindow)
Case "Explorer"
Set GetCurrentItem = objApp.ActiveExplorer.Selection.Item(1)
Case "Inspector"
Set GetCurrentItem = objApp.ActiveInspector.CurrentItem
End Select
Set objApp = Nothing
End Function
I have set a breakpoint and checked the UserProperties of the MailItem. I see that the details are there and the value is set to "True". However, the email does not show the Yes/No icon in the "Note" column of the email pane of Outlook.
How do I get Outlook to show my user defined property value in the email pane when I add the column to the view?
A save is required for a selection. An Inspector item prompts for a save.
Private Sub MarkHasNote_DisplayTest()
' Add the UserProperty column with Field Chooser
' You can view the value toggling when you run through the code
Dim Selection As Selection
Dim UserDefinedFieldName As String
Dim objProperty As UserProperty
Dim objItem As mailItem
UserDefinedFieldName = "NoteTest"
Set objItem = GetCurrentItem()
Set objProperty = objItem.UserProperties.Add(UserDefinedFieldName, Outlook.OlUserPropertyType.olYesNo, olFormatYesNoIcon)
objProperty.Value = Not objProperty.Value
' Required for an explorer selection
objItem.Save
' For an inspector item there would be a prompt to save
' if not already done in the code
End Sub
I have already wrote a code where the when ever a email comes from a definite email ID to outlook my ID it gets sent to anothee email address automatically by using one rule.
Now I have to add one feature. This mail which is sent is also saved in a dedicated folder other than sent items. All this in one script.
This my current script where only the mail goes automatically. Now I need help to add the dedicated folder feature.
Sub Project_1()
Dim objMail As Outlook.MailItem
Set objItem = GetCurrentItem()
Set objMail = objItem.Forward
objMail.To = "inbox#email.com"
objMail.Display
objMail.Send
Set objItem = Nothing
Set objMail = Nothing
End Sub
Function GetCurrentItem() As Object
Dim objApp As Outlook.Application
Set objApp = Application
On Error Resume Next
Select Case TypeName(objApp.ActiveWindow)
Case "Explorer"
Set GetCurrentItem = _
objApp.ActiveExplorer.Selection.Item(1)
Case "Inspector"
Set GetCurrentItem = _
objApp.ActiveInspector.CurrentItem
Case Else
End Select
End Function
I am very new to VBA.
As #destination-data stated above, the whole task will be much easier through outlooks rules.
This article is a step-by-step guide on how to set rules for moving certain mails based on conditions. Additionally you can easily add a "forward" rule, since all your desired functionality is already implemented into outlook and one should avoid rewriting existing tools.
According to your description, this should accomplish the exact same thing as intended by your code.