Outlook 2013 Script Assistance - Save Opened Link with Subject Added

Outlook version
Outlook 2013 64 bit
Email Account
Exchange Server
Good morning!

I believe that I now have the two "pieces" that I need to achieve my goal.
How do I modify CODE ONE so that it saves the linked object with the Subject Line included?
CODE TWO (below) is the code snippet I think I need for this.

CODE ONE

Code:
Private Declare Function ShellExecute _

Lib "shell32.dll" Alias "ShellExecuteA" ( _

ByVal hWnd As Long, _

ByVal Operation As String, _

ByVal Filename As String, _

Optional ByVal Parameters As String, _

Optional ByVal Directory As String, _

Optional ByVal WindowStyle As Long = vbMinimizedFocus _

) As Long



Sub OpenLinksMessage()

Dim olMail As Outlook.MailItem

Dim Reg1 As RegExp

Dim M1 As MatchCollection

Dim M As Match

Dim strURL As String

Dim lSuccess As Long



Set olMail = Application.ActiveExplorer().Selection(1)



Set Reg1 = New RegExp



With Reg1

.Pattern = "(https?[:]//([0-9a-z=\?:/\.&-^!#$%;_])*)"

.Global = True

.IgnoreCase = True

End With



If Reg1.Test(olMail.Body) Then



Set M1 = Reg1.Execute(olMail.Body)

For Each M In M1

strURL = M.SubMatches(0)

Debug.Print strURL

If InStr(strURL, "unsubscribe") Then GoTo NextURL

If Right(strURL, 1) = ">" Then strURL = Left(strURL, Len(strURL) - 1)



lSuccess = ShellExecute(0, "Open", strURL)

DoEvents



NextURL:

Next

End If



Set Reg1 = Nothing

End Sub
CODE TWO

Code:
' get the subject from the header

strTemp = propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x0070001E")

aItem.Subject = strTemp

  

    Set Reg1 = CreateObject("VBScript.RegExp")

    With Reg1

        .Pattern = "(Subject:\s(.*)\n(.*))"

        .Global = True

    End With

    

    If Reg1.Test(strHeader) Then

    

        Set M1 = Reg1.Execute(strHeader)

        For Each M In M1

        strTemp = M.SubMatches(1)

        Next

    End If

  

      aItem.Subject = strTemp

     iItemsUpdated = iItemsUpdated + 1

    aItem.Save

Next aItem



MsgBox iItemsUpdated & " of " & mail.Items.Count & " Messages Updated"

Set myolApp = Nothing

 
Top