Adding Subject to this Link-Saving VBA

[misterbobthetomato]

Hi folks...

This script does exactly what I want it to do...except...
I'd like it to add the Subject Line from the email as part of the file name.
I saw a possibility somewhere ["newName=itm.subject"] but whatever works is great.
What shall I add and where shall I add it?

Thank you so much.

Bob

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).itm.Subject

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

 

[misterbobthetomato]

Correction.
Set olMail = Application.ActiveExplorer().Selection(1).itm.Subject
should be
Set olMail = Application.ActiveExplorer().Selection(1).

 

[Diane Poremsky]

Correction.
Set olMail = Application.ActiveExplorer().Selection(1).itm.Subject
should be
Set olMail = Application.ActiveExplorer().Selection(1).

without the last period...

Dang, was posted before I was ready. This macro opens a url, it doesn't save the message.

To add the subject, you would use olmail.subject - but need to run it though an illegal character function to remove characters not supported in file names. There are a couple of different ways of doing it - the sample at the link below uses a function to replace the illegal characts with a character of your choice- in this example, a dash.

sName = oMail.Subject
ReplaceCharsForFileName sName, "-"

Private Sub ReplaceCharsForFileName(sName As String, _
sChr As String _
)
sName = Replace(sName, "'", sChr)
sName = Replace(sName, "*", sChr)
sName = Replace(sName, "/", sChr)
sName = Replace(sName, "\", sChr)
sName = Replace(sName, ":", sChr)
sName = Replace(sName, "?", sChr)
sName = Replace(sName, Chr(34), sChr)
sName = Replace(sName, "<", sChr)
sName = Replace(sName, ">", sChr)
sName = Replace(sName, "|", sChr)
End Sub

Save Selected Email Message as .msg File

A VBA code sample to save one or more selected messages to your My Documents folder as .msg files, using the received date and time as the filename.

www.slipstick.com

 

[misterbobthetomato]

Hi Diane.
I've tried to figure out where to place this properly. No luck yet. Please advise.

sName = oMail.Subject

 

[Diane Poremsky]

Are you saving attachments or files that are downloaded from links in the email? Its more difficult to change the filename when its downloaded. I think you'll need to change it after the file is saved. I'll see if i can find any code.

 

[misterbobthetomato]

Are you saving attachments or files that are downloaded from links in the email? Its more difficult to change the filename when its downloaded. I think you'll need to change it after the file is saved. I'll see if i can find any code.

Saving the files that are downloaded.