running multiple macros at once

[holleymc]

Operating system::    Windows 10
Outlook version:     Outlook 365
Email type or host:    Microsoft 365

---

Hello all! I have two macros that I would like to combine into a single step. Macro 1is opens a template, paste the clipboard contentes into the body of the template. Macro 2 copies the email address from the body of hte email and paste it into the To field of the email. Each of these work great individually, but I cannot even do a simple "call" for these two to work together. Any suggestions?

One other tweak I would like to make is for it to copy the Customer # and past it within the subject line of the email, but if that never happens, if I could just get the first two to work together, that would be be most appreciated!

I would greatly appreciate any suggestions!

This is the two codes:
Macro 1

Dim MyItem As Outlook.MailItem
Dim str_jpeg_file As String

Dim wdDoc As Object
Dim oRng As Object
    
    'On Error Resume Next
    Set OutApp = GetObject(, "Outlook.Application")
    If Err <> 0 Then Set OutApp = CreateObject("Outlook.Application")
    On Error GoTo 0
    
    'Set OutMail = OutApp.CreateItem(0)
    Set MyItem = Application.CreateItemFromTemplate("C:\Users\user2\Documents\Customer Statement .msg")
    MyItem.Display
    With MyItem
        .BodyFormat = 2
       ' .To = ""
       ' .CC = ""
        '.BCC = ""
        .Subject = "Customer Statement "

SendKeys "{right}{down}^({v})", True
End With
End Sub

Macro 2

Sub ReadMsg2()
'Graham Mayor - https://www.gmayor.com - Last updated - 06 Jul 2024
Dim olMsg As MailItem
    On Error Resume Next
    Select Case Outlook.Application.ActiveWindow.Class
        Case olInspector
            Set olMsg = ActiveInspector.CurrentItem
        Case olExplorer
            Set olMsg = Application.ActiveExplorer.Selection.Item(1)
    End Select
   GetAddress olMsg
lbl_Exit:
    Set olMsg = Nothing
    Exit Sub
End Sub
Sub GetAddress(olItem As MailItem)
Dim olInsp As Outlook.Inspector
Dim wdDoc As Object
Dim oRng As Object
Dim oAddr As Object
Dim hLink As Object
    With olItem
        Set olInsp = .GetInspector
        Set wdDoc = olInsp.WordEditor
        Set oRng = wdDoc.Range
        With oRng.Find
            Do While .Execute(findText:="Sincerely")
                Set oAddr = oRng
                Exit Do
            Loop
        End With
        If Not oAddr Is Nothing Then
            oAddr.collapse 1
            oAddr.MoveStartUntil "@", -1073741823
            Set oAddr = oAddr.Paragraphs(1).Range
            If Not oAddr Is Nothing Then
                olItem.To = oAddr.Text
                oAddr.Text = ""
            End If
        End If
    End With
lbl_Exit:
    Set olInsp = Nothing
    Set wdDoc = Nothing
    Set oRng = Nothing
    Set oAddr = Nothing
    Exit Sub
End Sub