Hyperlink a cell to a .msg file from a button

Hi Arkadi,

Thanks for the response

when an email is either sent or received by someone they will go to the register and press either button, this will then look at the server(which is a mapped drive - \\servername\projects) where the latest email should have been saved in either sent or received, it will then put a hyperlink in column D and rename the .msg to the next number based on column A and insert the date based on today (Cell A1). all other information should will be inputted manually, unless it could be extracted from the email?

I'm new to code but I spend hours inputting this information into registers daily and wanted to speed things up.

Thanks

Thinking about it I could get away completely with the sent and received folders and just have one Correspondence folder so to not confuse matters.

I have attached a new example

Very good point!

When you save an email it saves it based on the Subject, what if we put the subject into Column C - Email Details and then rename it after?

Or manually rename it when we save it.

the other option would be to create a macro in Outlook to save the email automatically to the correct folder and then input the information into excel from outlook, but I'm assuming this would be a lot of code

Yes, the list will keep expanding throughout the lifecycle of a project.

the code wouldn't know which one to rename unless we could select the email, or if we rename the email when we save it from outlook. we would differentiate the sent or received based on Column B and F and this would be down the user to understand.

the code would know which emails have been taken care once the email has been hyperlinked because the date is the date of the email (either sent or received)

Hi Arkadi,

I have had a good think about what is required based on your comments and have put together a new solution, I don't think what I require can be completed in excel but any comments would be greatly appreciated.

1. When an email is either received or sent you go to a the macros and press save
2. When you press save a text input box will appear where you can insert the customer name and project number
3. this will then search through my works server to find the folder and open the correspondence folder
4. once the folder has been open the email will be saved in that location with the date and time as a prefix to the subject.
5. once this has been done an excel workbook will be opened and information from the email will be saved in the excel document (email addresses/subject/dates/To and From/Hyperlink to email)
6.once this has been completed it will ask if you want to keep the email in your inbox or sent items Yes to keep no to delete.

Thanks in advance
Nathan

Arkadi,

Thanks for your help with this its much appreciated.

Nathan

snb,

Thanks for the post I will have a look and see if I can find anything.

Hi Arkadi,

I have managed to get the code to work for saving emails into a folder located on a server folder from outlook.
[CODE][/ Option Explicit
Function BrowseForFolder(Optional OpenAt As Variant) As Variant
Dim ShellApp As Object
Set ShellApp = CreateObject("Shell.Application"). _
BrowseForFolder(0, "Please choose a folder", 0, OpenAt)

On Error Resume Next
BrowseForFolder = ShellApp.self.Path
On Error GoTo 0

Set ShellApp = Nothing
Select Case Mid(BrowseForFolder, 2, 1)
Case Is = ":"
If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid
Case Is = "\"
If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid
Case Else
GoTo Invalid
End Select
Exit Function

Invalid:
BrowseForFolder = False
End Function

Public Sub SaveMessageAsMsg()
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
Dim strFolderpath As String

enviro = CStr(Environ("FILEDIRECTORY"))

strFolderpath = BrowseForFolder(enviro & "\\NEWBENSON\Projects")

For Each objItem In ActiveExplorer.Selection
If objItem.MessageClass = "IPM.Note" Then
Set oMail = objItem

sName = oMail.Subject
ReplaceCharsForFileName sName, "-"

dtDate = oMail.ReceivedTime
sName = Format(dtDate, "yyyymmdd", vbUseSystemDayOfWeek, _
vbUseSystem) & Format(dtDate, "-hhnnss", _
vbUseSystemDayOfWeek, vbUseSystem) & "-" & sName & ".msg"

sPath = strFolderpath & "\"
Debug.Print sPath & sName
oMail.SaveAs sPath & sName, olMSG

End If
Next

End Sub

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

CODE]