Outlook  VSTO

Ribbon Type (for creating a button in my case)

Click on the top most Ribbon properties and then you'll see it

2019-09-13 14_23_54-Clipboard

Put the Group and buttons on the HOME tab

Change to TabMail (TabHome did not work for me)

2019-09-13 15_00_07-Clipboard

https://www.c-sharpcorner.com/article/how-to-add-a-button-to-existing-ribbon-tab-in-office-applications2/

Start a Process

One Off Process

System.Diagnostics.Process.Start("iexplore", "http://www.yoursite.com")

Controlled Process

    Dim myProcess as new System.Diagnostics.Process()

 

    myProcess.StartInfo = new System.Diagnostics.ProcessStartInfo("iexplore")

    myProcess.Arguments = yourWebsite

    myProcess.Start()

'Kill the process when you want to

    myProcess.Kill()

  https://social.msdn.microsoft.com/Forums/windows/en-US/63e7cddd-e29f-40f4-9e1e-634ac12cbf5c/open-ie-and-navigate-from-vbnet?forum=winforms


Button click to manipulate current/active email

    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click

        'On Error Resume Next

        Dim ThisOutlookSession As Outlook.Application = New Outlook.Application

        Dim NS As Outlook.NameSpace = ThisOutlookSession.Session

        Dim objsel As Outlook.MailItem

        Me.Hide()

        'Check it's Inspector or Explorer Window

        If TypeName(ThisOutlookSession.ActiveWindow) = "Inspector" Then

            'MsgBox("Inspector")

            objsel = ThisOutlookSession.ActiveInspector.CurrentItem

            'objsel.Subject += vbCrLf

            objsel.Save()

            subSendFax(objsel)

            'MsgBox(objsel.Subject.ToString)

        Else

            MsgBox("Explorer")

            'Get the selected item for processing

            objsel = ThisOutlookSession.ActiveExplorer.Selection.Item(1)

            'Check the relevant item and process per your logic

            If (TypeOf objsel Is Outlook.MailItem) Then

                Dim mailItem As Outlook.MailItem =

                        TryCast(objsel, Outlook.MailItem)

                'MsgBox("Mail Item's Subject" & mailItem.Subject)

                'Implement your business logic here

            End If

        End If

    End Sub


Sorting Outlook Emails into Subfolders

Sub MoveEmailToStorageFormatted()

 'On Error Resume Next

    Dim curMail As Outlook.MailItem

 For x = 1 To Application.ActiveExplorer.Selection.count

 Debug.Print x

    Set curMail = GetCurrentItem(x)

   

    Call MoveAndFormat(curMail)

 Next

End Sub


Sub CreateFolders(sPath, level, ByRef oFolder As Folder)

  On Error Resume Next

  

  sLevel = Split(sPath, "\")(level)

  Debug.Print "sLevel = " & sLevel & vbTab & "Level = " & level

  If Len(sLevel) > 0 Then

   'If IsNull(oFolder.Folders(sLevel)) Then

    Debug.Print "IsNull"

    Debug.Print "Adding: " & sLevel

    oFolder.Folders.Add sLevel

    Set oFolder = oFolder.Folders(sLevel)

     Call CreateFolders(sPath, level + 1, oFolder)

   'End If

 End If

   

   

  On Error GoTo 0

End Sub

  

    Sub CreateFolder(ByVal strPath)

        On Error Resume Next

        

        If Not objFSO.FolderExists(objFSO.GetParentFolderName(strPath)) Then Call CreateFolder(objFSO.GetParentFolderName(strPath))

        objFSO.CreateFolder (strPath)

        On Error GoTo 0

    End Sub

    

 

' From http://www.outlookcode.com/codedetail.aspx?id=50

Function GetCurrentItem(x) As Object

    Dim objApp As New Outlook.Application

         

    'Set objApp = CreateObject("Outlook.Application")

    On Error Resume Next

    Select Case TypeName(objApp.ActiveWindow)

        Case "Explorer"

            Set GetCurrentItem = objApp.ActiveExplorer.Selection.Item(x)

        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 MoveAndFormat(themail As MailItem)

On Error Resume Next

 Dim xFolder As Folder, out As Folder

 

'Set xFolder = Application.session.Folders.Item("Inbox")

' Item Can be Mailbox - <first> <lastname>

Set xFolder = Application.session.Folders.Item("Mailbox - Rich Lemmermann")

 

 

  Debug.Print themail.SenderName

  Debug.Print themail.SentOn & vbTab & Year(themail.SentOn)

  sDestFolder = "Inbox\" & Year(themail.SentOn) & "\" & themail.SenderName

 Call CreateFolders(sDestFolder, 0, xFolder)

 

 Set out = GetFolder(sDestFolder, 0, xFolder)

 Debug.Print out.Name

 themail.UnRead = False

 

 themail.Move out

 

End Sub

Function GetFolder(sPath, level, oFolder)

  On Error Resume Next

  sLevel = Split(sPath, "\")(level)

  Debug.Print "sLevel = " & sLevel & vbTab & "Level = " & level

  If Len(sLevel) > 0 Then

    

    Set oFolder = oFolder.Folders(sLevel)

    Call GetFolder(sPath, level + 1, oFolder)

  End If

   

  Set GetFolder = oFolder

   

  On Error GoTo 0

End Function

Send a fax (example of manipulating To line)

    Sub subSendFax(mail As Outlook.MailItem)

        Dim sNumber As String = ""

        Dim recipients As Outlook.Recipients

        Dim recipient As Outlook.Recipient

        recipients = mail.Recipients

        'sNumber = funWhatever(sToLine.ToString)

        'sNumber = "3156993964"

        Dim sToLine As String

        If Label1.Text = "O365" Then

            sToLine = "/Name=Fax/Fax=" & TextBox2.Text & "/rfax@faxtest.crouse.org"

        Else

            sToLine = "[rfax:Fax@/FN=" & TextBox2.Text & "]"

        End If

        mail.To = ""

        recipient = recipients.Add(sToLine.ToString)

        MsgBox(sToLine.ToString)

        '/Chad=Test/Fax=3156993964/rfax@faxtest.crouse.org

        'Console.WriteLine(mail.To.ToString)

        recipient.Resolve()

        'mail.Send()

    End Sub

Example of going through all Recipients in ItemSend() method

  Private Sub Application_ItemSend(Item As Object, ByRef Cancel As Boolean) Handles Application.ItemSend

        'https://www.add-in-express.com/creating-addins-blog/2011/09/12/outlook-change-message-before-sending/

        'Dim recipient As Outlook.Recipient = Nothing

        'Dim recipients As Outlook.Recipients = Nothing

        'Dim mail As Outlook.MailItem = TryCast(Item, Outlook.MailItem)

        'If Not IsNothing(mail) Then

        '    Dim addToSubject As String = " !IMPORTANT"

        '    Dim addToBody As String = "Sent from my Outlook 2010"

        '    If Not mail.Subject.Contains(addToSubject) Then

        '        mail.Subject += addToSubject

        '    End If

        '    If Not mail.Body.EndsWith(addToBody) Then

        '        mail.Body += addToBody

        '    End If

        '    recipients = mail.Recipients

        '    recipient = recipients.Add("Eugene Astafiev")

        '    recipient.Type = Outlook.OlMailRecipientType.olBCC

        '    recipient.Resolve()

        '    If Not IsNothing(recipient) Then Marshal.ReleaseComObject(recipient)

        '    If Not IsNothing(recipients) Then Marshal.ReleaseComObject(recipients)

        'End If

        Dim bOnPrem As Boolean = False

        Dim ThisOutlookSession As Outlook.Application = New Outlook.Application

        Dim NS As Outlook.NameSpace = ThisOutlookSession.Session

        If NS.ExchangeMailboxServerName.Contains("vs8cashub") Then

            bOnPrem = True ' = "onPrem"

        Else

            bOnPrem = False ' = "O365"

        End If

        'Dim recipient As Outlook.Recipient = Nothing

        Dim recipients As Outlook.Recipients = Nothing

        Dim mail As Outlook.MailItem = TryCast(Item, Outlook.MailItem)

        If Not IsNothing(mail) Then

            recipients = mail.Recipients

            For Each recipient As Outlook.Recipient In recipients

                Console.WriteLine(recipient.Name & " -> " & recipient.Class.ToString)

                Try

                    If recipient.AddressEntry.Members IsNot Nothing Then

                        For Each x As Outlook.AddressEntry In recipient.AddressEntry.Members

                            Dim sReturn As String = funGetFaxStringOrReturnSameValue(x.Address.ToString, bOnPrem, x.Type.ToString)

                            'MsgBox(x.Type.ToString)

                            mail.Recipients.Add(sReturn.ToString)

                        Next

                        recipient.Delete()

                    Else

                        Dim sReturn As String = funGetFaxStringOrReturnSameValue(recipient.Address.ToString, bOnPrem, recipient.Type.ToString)

                        'MsgBox(x.Type.ToString)

                        mail.Recipients.Add(sReturn.ToString)

                        recipient.Delete()

                    End If

                Catch ex As Exception

                    Console.WriteLine("ERROR: " & ex.Message.ToString)

                End Try

                '

            Next

            mail.Recipients.ResolveAll()

            'For Each recipient As Outlook.Recipient In recipients

            '    If TypeOf recipient Is Outlook.ContactItem Then

            '        Dim contactItem As Outlook.ContactItem = TryCast(recipient, Outlook.ContactItem)

            '        For Each x In contactItem.AddressEntries

            '            MsgBox(x.ToString)

            '        Next

            '    End If

            'Next

            'Dim addToSubject As String = " !IMPORTANT"

            'Dim addToBody As String = "Sent from my Outlook 2010"

            'If Not mail.Subject.Contains(addToSubject) Then

            ' mail.Subject += addToSubject

            'End If

            'If Not mail.Body.EndsWith(addToBody) Then

            'mail.Body += addToBody

            'If

            recipients = mail.Recipients

            'ecipient = recipients.Add("Eugene Astafiev")

            'recipient.Type = Outlook.OlMailRecipientType.olBCC

            'recipient.Resolve()

            'If Not IsNothing(recipient) Then Marshal.ReleaseComObject(recipient)

            If Not IsNothing(recipients) Then Marshal.ReleaseComObject(recipients)

            mail.Save()

            'Cancel = True

        End If

    End Sub

http://www.vbaexpress.com/forum/showthread.php?53174-VBA-to-expand-Outlook-Distribution-Group-before-send

Function funGetFaxStringOrReturnSameValue(sPotentialFaxEmail As String, bOnPrem As Boolean, sType As String) As String

        If LCase(sType) = "fax" Then

            'we know it's a fax. change it to somehitng so that it'll properly get handled.

            sPotentialFaxEmail = "[rfax:FAX@/FN=" & funGrabBetween(sPotentialFaxEmail & vbCrLf, "@", vbCrLf) & "]"

        End If

        'handle what should work in an ideal solution

        If InStr(LCase(sPotentialFaxEmail), "rfax@faxtest.crouse.org") > 0 Then

            If Not bOnPrem Then

                Return sPotentialFaxEmail 'Already in corerct format

            Else

                'sToLine = "[rfax:Fax@/FN=" & TextBox2.Text & "]"

                Return Regex.Replace("[rfax:FAX@/FN=" & funGrabBetween(sPotentialFaxEmail, "Fax=", "/rfax@faxtest.crouse.org") & "]", "[^A-Za-z0-9\@\.\=/]", "")

            End If

            'Fax

        ElseIf InStr(LCase(sPotentialFaxEmail), "fn=") > 0 Then

            'fax

            If bOnPrem Then

                Return sPotentialFaxEmail 'Already in corerct format

            Else

                'sToLine = "/Name=Fax/Fax=" & TextBox2.Text & "/rfax@faxtest.crouse.org"

                'Regex.Replace(, "[^A-Za-z0-9\@\.\=/]", "")

                Return Regex.Replace("/Name=Fax/Fax=" & funGrabBetween(sPotentialFaxEmail & "]", "FN=", "]") & "/rfax@faxtest.crouse.org", "[^A-Za-z0-9\@\.\=/]", "")

            End If

        End If

        Return sPotentialFaxEmail 'if nothing above, just return what it is

    End Function

Center for to Screen or Parent Window

Screen

  Me.CenterToScreen()

Parent Window

    Public Shared Sub CenterForm(ByVal frm As Form, Optional ByVal parent As Form = Nothing)

        '' Note: call this from frm's Load event!

        Dim r As Rectangle

        If parent IsNot Nothing Then

            r = parent.RectangleToScreen(parent.ClientRectangle)

        Else

            r = Screen.FromPoint(frm.Location).WorkingArea

        End If

        Dim x = r.Left + (r.Width - frm.Width) \ 2

        Dim y = r.Top + (r.Height - frm.Height) \ 2

        frm.Location = New Point(x, y)

    End Sub

'https://blogs.msdn.microsoft.com/deva/2009/02/17/how-to-get-explorer-inspector-selected-mail-item-using-outlook-object-model-oom-net/