nathandavies
Member
- Outlook version
- Outlook 2010 64 bit
- Email Account
- Exchange Server
I have an 2 issue's with the following code, which i was hoping someone could help me with....
1. The code only allows me to input the full folder name to save the email on my server, i would like it to use just the number element. This is a general folder name: "13469 - ABB - Project Grange UK". I would like the code to just find the folder directory based on "13469"...is this possible?
2.My code does not take into account that the project folder is a sub folder of a main folder. I need to create a code that loops through the main folders which are a set out : "13400 - 13499" but range from "0001 - 0100" up to "5000 - 5900"
This is an example of one project layout....P:\Group\JOBDATA\13400 - 13499\13469 - ABB - Project Grange UK"
1. The code only allows me to input the full folder name to save the email on my server, i would like it to use just the number element. This is a general folder name: "13469 - ABB - Project Grange UK". I would like the code to just find the folder directory based on "13469"...is this possible?
2.My code does not take into account that the project folder is a sub folder of a main folder. I need to create a code that loops through the main folders which are a set out : "13400 - 13499" but range from "0001 - 0100" up to "5000 - 5900"
This is an example of one project layout....P:\Group\JOBDATA\13400 - 13499\13469 - ABB - Project Grange UK"
Code:
Sub JOBDATA_SAVE_EMAIL()
'The unique number of your project
Dim ProjectID As String
'the mail we want to process
Dim objItem As Outlook.MailItem
'question for saving, use subject to save
Dim strPrompt As String, strname As String, emailto As String, emailfrom As String
'variables for the replacement of illegal characters
Dim sreplace As String, mychar As Variant, strdate As String
'mypath as variant when using browsefolder function (false is boolean and no string)
Dim mypath As Variant
'put active mail in this object holder
Set objItem = Outlook.ActiveExplorer.Selection.Item(1)
'check if it's an email
If objItem.Class = olMail Then
mypath = ""
'check on subject
If objItem.Subject <> vbNullString Then
strname = objItem.Subject
Else
strname = "No_Subject"
End If
'ask until a projectid is given
Do Until Right(mypath, 1) <> "\" And mypath <> vbNullString
mypath = "P:\Group\JOBDATA\" & InputBox("Give EXISTING projectID ...", "Saving to Project ...")
Loop
'add ending slash
mypath = mypath & "\"
'select if the selected mail is located in the inbox or sent items folder
Select Case objItem.Parent
Case Outlook.Session.GetDefaultFolder(olFolderInbox)
'change saving path accordingly
mypath = mypath & "Correspondence\Email.In\"
emailfrom = objItem.Sender
Case Outlook.Session.GetDefaultFolder(olFolderSentMail)
mypath = mypath & "Correspondence\Email.Out\"
emailto = objItem.To
End Select
strdate = objItem.ReceivedTime
'define the character that will replace illegal characters
sreplace = "_"
'create an array to loop through illegal characters (saves lines)
For Each mychar In Array("/", "\", ":", "?", Chr(34), "<", ">", "¦")
'do the replacement for each character that's illegal
If emailfrom <> vbNullString Then
emailfrom = Replace(emailfrom, mychar, sreplace)
End If
If emailto <> vbNullString Then
emailto = Replace(emailto, mychar, sreplace)
End If
strname = Replace(strname, mychar, sreplace)
strdate = Replace(strdate, mychar, sreplace)
Next mychar
If emailto <> vbNullString Then
'emailto not empty means outgoing mail
'strdate is based on the european date system (dd/mm/yyyy). splitting text gives an array
'starting with 0. In this case, we split on space to get date alone and not the time
'(2) before & contains the year
'(1) before & contains the month
'(0) before & contains the day
'
'the (0) before the , contains the first part of date and time of the string "21_11_2014 12_30_55"
'since we split the first time with the splitseparator space we get "21_11_2014"
'then we use the split with separator _ to get 3 parts of the date
objItem.SaveAs mypath & _
Split(Split(strdate, " ")(0), "_")(2) & "-" & _
Split(Split(strdate, " ")(0), "_")(1) & "-" & _
Split(Split(strdate, " ")(0), "_")(0) & " - " & _
Split(strdate, " ")(1) & " -- " & emailto & " -- " & strname & ".msg", olMSG
Else
'emailto empty means received email = inbox
objItem.SaveAs mypath & _
Split(Split(strdate, " ")(0), "_")(2) & "-" & _
Split(Split(strdate, " ")(0), "_")(1) & "-" & _
Split(Split(strdate, " ")(0), "_")(0) & " - " & _
Split(strdate, " ")(1) & " -- " & emailfrom & " -- " & strname & ".msg", olMSG
End If
'If you answer is yes on this question, the selected email will be deleted from the mailfolder
'in outlook.
If MsgBox("Delete saved email ?", vbYesNo, "Deleting saved email ?") = vbYes Then
objItem.Delete
End If
End If
End Sub