misterbobthetomato
Member
- 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 TWO
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 SubCODE 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
