Sub LinkToQuotation() Dim oMail As Outlook.MailItem Dim objItem As Object Dim sPath As String Dim dtDate As Date Dim sName As String Dim enviro As String enviro = CStr(Environ("USERPROFILE")) For Each objItem In ActiveExplorer.Selection Set oMail = objItem sName = oMail.Subject & ".msg" ReplaceCharsForFileName sName, " " sPath = "D:\Dropbox\calc quotations\" Debug.Print sPath & sName oMail.SaveAs sPath & sName, olMSG Range("E3").Select ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=sPath & sName, TextToDisplay:="Link to Email" Next End Sub
var
This content, along with any associated source code and files, is licensed under The Code Project Open License (CPOL)