Email Management
Email Management
(OP)
When managing a project we send and receive a large number of Emails using MS outlook. These we drag and drop into a common folder on our network for reference.
However we give the Email a sequential number for out going and another for incoming mails. So when sending a mail the sequence of open up a number index on word, copy the header with number, send the mail. Go to the send items box and drag and drop into the appropriate folder then delete the outbox version so this does not get copied a gain.
How do other people mange project Emails and is there a better way
However we give the Email a sequential number for out going and another for incoming mails. So when sending a mail the sequence of open up a number index on word, copy the header with number, send the mail. Go to the send items box and drag and drop into the appropriate folder then delete the outbox version so this does not get copied a gain.
How do other people mange project Emails and is there a better way






RE: Email Management
To retrieve a message, you have to imagine what he would have called it, or where he thought it should go in the folder tree, or search for it, based on what you conjecture is in the message body. Good luck with that.
There HAS TO BE a better way. I'm hoping someone will chime in with it.
Mike Halloran
Pembroke Pines, FL, USA
RE: Email Management
corus
RE: Email Management
Or set up shared accounts. (Google sharing email)
A 'simple' manual method would be:
Setup a PST file for each project on each users outlook account. Give the PST file the project name and or number, and the users name. (e.g. Test-123-CBL.pst)
Have each user be responsible for storing pertinent emails (received and sent) into this folder (or set up rules to re-direct automatically).
The pst files could then be copied to a central access point for others to read. (read only)
These should eliminate the need for drag and dropping, and renaming, and complete conversations would be available as per normal.
RE: Email Management
I am also interested in the auto numbering of Emails. Since the QA highlighted that if you lose a mail either electronic or paper how do you know that it existed in the first place. If it had a number then there would be a number missing.
I am thinking of programming the step but I hope that there is a better way.
RE: Email Management
Mike Halloran
Pembroke Pines, FL, USA
RE: Email Management
So far I have only used the trial version, but am seriously contemplating buying standard version.
Fred
RE: Email Management
I am interested in the PST file approach. How do you setup these files? Are they viewable from Outlook without having to move or copy anything?
RE: Email Management
RE: Email Management
Care to share your code?
RE: Email Management
I have started writing a similar macro but this is a job done in my "spare time" i.e. is not getting done.
I want to add and sequentially number the mails as well and check for duplicates in order to suffix them with another character.
The other part I intend to develop is to save the attachments in a folder with the same name as the email.
CSFEng
Any chance of sharing your code (said with hands clasped together in a begging / praying body language stance and puppy dog eyes)
RE: Email Management
RE: Email Management
CODE
'---------
'version 6.0.1
'---------
Dim JobNo As String, where As String
Dim DTName As String, IndexName As String
Dim JobFolder As String, IsFolder As String
Dim email As MailItem
Dim journal As JournalItem
Dim fso As Object
Dim Info As String
Sub SaveMsg()
'***************************************************
'save emails or faxes (attached to email) that are sent or recieved
'possibly add journal entries to track phone calls in future.
'***************************************************
Dim myOlApp As Outlook.Application
Dim mySelection As Selection
Dim i As Integer
Dim HaveNumber() As String
Dim temp As Variant
Dim FaxInfo(1) As String
Dim myFile As Attachment
Dim Faxname As String
Dim EmailName As String
Dim CleanName As String
'On Error Resume Next
IsFolder = ""
Set myOlApp = Application
Set mySelection = myOlApp.ActiveExplorer.Selection
Set fso = CreateObject("Scripting.FileSystemObject")
'check email subject for our 8 digit job number
HaveNumber = Split(mySelection.Item(1).Subject, " ")
For Each temp In HaveNumber
If temp Like "########" Or temp Like "########-*" And Left(temp, 1) = 0 Then 'need to fix in 2010
JobNo = temp
Info = Join(Filter(HaveNumber, JobNo, False))
Exit For
Else
JobNo = ""
End If
Next temp
'call routine to prompt for number (or use one from subject)
sCheckJobNumber
'verify job folder to save email exists on server
If IsFolder Like "NoFolder" Then
MsgBox "Cannot Find Folders: " & Chr(13) & _
"R:\Product\" & JobNo & "\Corres\" & Chr(13) & _
"R:\Bid\" & JobNo & "\Corres\"
Exit Sub
ElseIf IsFolder Like "Cancel" Then Exit Sub
End If
'prompt to verify job name is correct based on job number entered (double check for typo)
fCheckJobName
If IsFolder Like "Cancel" Then Exit Sub
'step through all selected entities and save them - must verify if email or fax
For i = mySelection.count To 1 Step -1
If mySelection.Item(i).Class = olMail Then
Set email = mySelection.Item(i)
Info = Trim(email.Subject)
If Info = "" Then Info = "not_fax"
'check to see if email contains a fax
If LCase(Split(Info, " ")(0)) = "fax" And email.Attachments.count > 0 Then 'this is a fax
Info = Right(Info, Len(Info) - 4)
temp = Split(Info, ":")
FaxInfo(0) = Trim(temp(0))
If UBound(temp) > 0 Then
FaxInfo(1) = Trim(temp(1))
Else
FaxInfo(1) = ""
End If
JobFolder = where & "In\"
Set myFile = email.Attachments(1)
'to get file info, must save first, get info, then rename file (use move)
myFile.SaveAsFile (JobFolder & myFile.FileName)
DTName = Format(FileDateTime(JobFolder & myFile.FileName), "yymmdd_hhmmss")
If FaxInfo(0) <> "" And FaxInfo(1) <> "" Then
Faxname = Left(JobFolder & DTName & "-" & FaxInfo(0) & ", " & FaxInfo(1), 255) & ".tif"
Else
Faxname = Left(JobFolder & DTName & "-" & FaxInfo(0) & FaxInfo(1), 255) & ".tif"
End If
fso.getfile(JobFolder & myFile.FileName).Move (Faxname)
IndexName = JobFolder & JobNo & "__Fax In.csv"
sFaxIndex Faxname, FaxInfo
Else 'it's not a fax, just an email
sSendorReceive
DTName = Format(email.ReceivedTime, "yymmdd_hhmmss")
CleanName = fStripIllegalChar(email.Subject)
EmailName = Left(JobFolder & DTName & "-" & CleanName, 251) & ".msg"
If fFileExists(EmailName) Then 'already have an email with the same name
MsgBox "Email name" & DTName & "-" & CleanName & " exists in correspondence folder, please rename"
Exit Sub
Else
email.SaveAs (EmailName)
End If
sWriteIndex 'create entry in a csv file to index emails and faxes
End If
email.Delete 'move to deleted item, we can always move back to inbox if needed
ElseIf mySelection.Item(i).Class = olJournal Then 'to do-journal archiving (code not started)
Set journal = mySelection.Item(i)
sJournalEntry
Else
MsgBox "Must be a mail or journal entry"
Exit Sub
End If
Next i
'cleanup
Set myOlApp = Nothing
Set mySelection = Nothing
Set fso = Nothing
End Sub
Private Sub sWriteIndex()
'***************************************************
'create a "summary" csv file that can be opened with excel to
'quickly look for emails. Creates separate csv for sent or received
'***************************************************
Dim Attachments As String
Dim FileNumber As Integer
Attachments = ""
If email.Attachments.count > 0 Then Attachments = fAttachmentList
FileNumber = FreeFile
If fso.FileExists(IndexName) = True Then
Open IndexName For Append As #FileNumber
Else
Open IndexName For Append As #FileNumber
If Left(Right(IndexName, 6), 2) = "In" Then
Write #FileNumber, "File Name", "Subject", "Received By", "Sent To", _
"Date Received", "From Name", "From Email", "Date Sent", "Attachments"
Else: Write #FileNumber, "File Name", "Subject", "Sent To", "Sent To Email," _
; "From Name", "From Email", "Date Sent", "Attachments"
End If
End If
If Left(Right(IndexName, 6), 2) = "In" Then
Write #FileNumber, _
DTName, _
email.Subject, _
email.ReceivedByName, _
email.To, _
email.ReceivedTime, _
email.SenderName, _
fGetEmailAddressReply, _
email.SentOn, _
Attachments
Else: Write #FileNumber, _
DTName, _
email.Subject, _
email.To, _
fSentToList, _
email.SenderName, _
fGetEmailAddressReply, _
email.SentOn, _
Attachments
End If
Close #FileNumber
End Sub
Private Sub sCheckJobNumber()
'***************************************************
'Verify Job number found in subject or entered from inputbox
'has a project folder created on the server. Must have folder
'to save email/fax
'***************************************************
JobNo = InputBox(Prompt:="Please enter job number ", Default:=JobNo)
If JobNo Like "" Then
IsFolder = "Cancel"
Exit Sub
End If
If fso.folderexists("R:\Product\" & JobNo & "\Corres\") Then
where = "R:\Product\" & JobNo & "\Corres\"
ElseIf fso.folderexists("R:\Bid\" & JobNo & "\Corres\") Then
where = "R:\Bid\" & JobNo & "\Corres\"
Else
IsFolder = "NoFolder"
End If
End Sub
Private Function fGetEmailAddressReply()
'***************************************************
'retrieve email address email was sent from
'***************************************************
Dim objRecips As Outlook.Recipients
Dim objRecip As Outlook.Recipient
Dim objReply As MailItem
Set objReply = email.reply
Set objRecips = objReply.Recipients
For Each objRecip In objRecips
fGetEmailAddressReply = objRecip.Address
Next objRecip
Set objReply = Nothing
Set objRecip = Nothing
Set objRecips = Nothing
End Function
Private Sub sSendorReceive()
'***************************************************
'determine if email was sent or received
'***************************************************
If email.ReceivedByName = "" Then
JobFolder = where & "\Out\"
IndexName = JobFolder & JobNo & "__Email Out.csv"
Else
JobFolder = where & "\In\"
IndexName = JobFolder & JobNo & "__Email In.csv"
End If
End Sub
Private Function fCheckJobName()
'***************************************************
'determine if project number is in our database and display
'input box for verification.
'Uses late binding.
'***************************************************
Dim cnndb As Object
Dim myrs As Object
Dim MySql As String
Dim verify As Integer
Set cnndb = CreateObject("ADODB.connection")
cnndb.ConnectionString = "Provider=MSDASQL; Driver={SQL Server}; Server=LGSDS01\AXIUM; " & _
"Database=Ajera; UID=; PWD=;"
cnndb.Open
Set myrs = CreateObject("ADODB.Recordset")
MySql = "SELECT projNum, projName, vecDescription " & _
"FROM LGS_JobList " & _
"WHERE projNum='" & JobNo & "'"
Set myrs = cnndb.Execute(MySql)
If myrs.EOF = True Then
verify = MsgBox("Cannot find " & JobNo & " in timesheet database, continue?" _
, vbYesNo, "Verify Information")
Else
verify = MsgBox(JobNo & Chr(13) & myrs(1).Value _
& Chr(13) & "for" & Chr(13) & myrs(2).Value _
& Chr(13) & Chr(13) & "Is this correct?" _
, vbYesNo, "Verify Information")
End If
If verify <> 6 Then IsFolder = "Cancel"
cnndb.Close
Set cnndb = Nothing
Set myrs = Nothing
End Function
Private Function fAttachmentList()
'***************************************************
'create a list of attached files names to be used
'in csv summary file.
'***************************************************
Dim AList As String
Dim Attach As Attachment
For Each Attach In email.Attachments
If Attach.Type <> olOLE Then
AList = AList & Attach.FileName & "; "
End If
Next Attach
fAttachmentList = Left(AList, Len(AList) - 2)
End Function
Private Function fSentToList()
'***************************************************
'create a list of email addresses that email was sent to
'for use in csv summary files.
'***************************************************
Dim myRecipient As Recipient
Dim RList As String
For Each myRecipient In email.Recipients
RList = RList & myRecipient.Address & "; "
Next myRecipient
fSentToList = Left(RList, Len(RList) - 2)
End Function
Private Sub sFaxIndex(Faxname As String, FaxInfo() As String)
'***************************************************
'create a "summary" csv file that can be opened with excel to
'quickly look for faxes. Currently only handles received faxes
'***************************************************
Dim FileNumber As Integer
FileNumber = FreeFile
If fso.FileExists(IndexName) = True Then
Open IndexName For Append As #FileNumber
Else
Open IndexName For Append As #FileNumber
Write #FileNumber, "Fax Name", "Sent To", "Sent By", "Company", "Received", "Number of Pages"
End If
Write #FileNumber, _
DTName, _
email.ReceivedByName, _
FaxInfo(0), _
FaxInfo(1), _
FileDateTime(Faxname), _
fNumPages(Faxname)
Close #FileNumber
End Sub
Private Function fNumPages(Faxname As String)
'***************************************************
'open fax .tif file to determine number of pages in fax
'***************************************************
Dim miDoc As Object
'Dim miDoc As MODI.Document
Set miDoc = CreateObject("MODI.Document")
'Set miDoc = New MODI.Document
miDoc.Create (Faxname)
fNumPages = miDoc.Images.count
Set miDoc = Nothing
End Function
Private Sub sJournalEntry()
'***************************************************
'this will be used for archiving journal entries
'currently not in use.
'***************************************************
MsgBox "journal"
End Sub
Private Function fStripIllegalChar(strInput)
'***************************************************
'function that removes illegal file system
'characters.
'***************************************************
Dim RegX As Object
'special regex chars aka metacharacters = [\^$.|?*+()
'invalid file characters = \ / : * ? " < > |
Set RegX = CreateObject("VBScript.RegExp")
RegX.Pattern = "[\\/:\*\?<>\|]"
RegX.IgnoreCase = True
RegX.Global = True
strInput = RegX.Replace(strInput, "")
RegX.Pattern = "[" & """" & "]"
RegX.IgnoreCase = True
RegX.Global = True
fStripIllegalChar = RegX.Replace(strInput, "''")
Set RegX = Nothing
End Function
Private Function fFileExists(ByVal PathName As String) As Boolean
'***************************************************
'verify a file exists in a certain location
'***************************************************
On Error Resume Next
fFileExists = (GetAttr(PathName) And vbDirectory) = 0
End Function
RE: Email Management
Thanks for the code I would have taken me months to write something like this. But you have given me the building blocks to do everything I want to.
I like the database for tracking mails.
Our QA is keen to log all correspondence automatically.
More stars for you.
RE: Email Management
Thanks for posting. As teaaddict stated it is a good place to start. Much appreciated.
-Mark
RE: Email Management
If anyone has any suggestions for improvements let me know.