Help with VBA please!

Status
Not open for further replies.

Alan McGowan

Senior Member
Outlook version
Outlook 2013 64 bit
Email Account
Exchange Server
The organisation I work for has a requirement to save incoming and outgoing emails in MSG format in a standard filenaming format to different locations on a server (different projects have different locations on server). As I can received hundreds of emails per day I am trying to develop some code to make this as simple as possible although I am very new to writing code and have managed to scrounge bits and pieces from the internet. One of the functions I have partially working is a prompt to save a sent email to the server folder. At present I have a userform that opens using Application_ItemSend. On this userform is a listbox which has the paths to the different folders on the server and I have a button that runs a routine that saves the email in MSG format in the selected folder. If this is a new email (i.e. not a reply of a forward) then it works fine. The problem is when I reply to a message or forward a message it is not my message that is being saved its the original message that I'm forwarding or replying to. I'm sure the problem is becase at the point the routine is ran the message hasn't actually been sent at that point. The code attached to my button is below.

I would really appreciate any help in solving this.

Sub SaveSent2_test()
Dim lngC As Long
Dim msgItem As Outlook.MailItem
Dim strPath As String
On Error Resume Next
strPath = UserForm3.TextBox1.Value

On Error GoTo 0
If strPath = "" Then Exit Sub
If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
If TypeName(Application.ActiveWindow) = "Explorer" Then
' save selected messages in Explorer window
If CBool(ActiveExplorer.Selection.Count) Then
With ActiveExplorer
For lngC = 1 To .Selection.Count
Set msgItem = .Selection.Item(lngC)
If .Selection(lngC).Class = olMail Then
MsgSaverTest strPath, .Selection(lngC)
End If
Next lngC
End With
End If
ElseIf Inspectors.Count Then

' save active open message
If ActiveInspector.CurrentItem.Class = olMail Then
MsgSaverTest strPath, ActiveInspector.CurrentItem
End If
End If
End Sub
Private Sub MsgSaverTest(strPath As String, msgItem As Outlook.MailItem)
Dim intC As Integer
Dim intD As Integer
Dim intE As Integer
Dim intF As Integer
Dim strMsgSubj As String
Dim strMsgTo As String
Dim senton As String
Dim senttime As String
senton = Format(Date, "yyyy-mm-dd")
senttime = Time
strMsgSubj = msgItem.Subject
strMsgTo = msgItem.To

' Clean out characters from Subject which are not permitted in a file name
For intC = 1 To Len(strMsgSubj)
If InStr(1, ":<&>""", Mid(strMsgSubj, intC, 1)) > 0 Then
Mid(strMsgSubj, intC, 1) = "-"
End If
Next intC
For intC = 1 To Len(strMsgSubj)
If InStr(1, "\/|*?", Mid(strMsgSubj, intC, 1)) > 0 Then
Mid(strMsgSubj, intC, 1) = "_"
End If
Next intC

' Clean out characters from Sender Name which are not permitted in a file name
For intD = 1 To Len(strMsgTo)
If InStr(1, ":<&>""", Mid(strMsgTo, intD, 1)) > 0 Then
Mid(strMsgTo, intD, 1) = "-"
End If
Next intD
For intD = 1 To Len(strMsgTo)
If InStr(1, "\/|*?", Mid(strMsgTo, intD, 1)) > 0 Then
Mid(strMsgTo, intD, 1) = "_"
End If
Next intD
' Clean out characters from Date which are not permitted in a file name
For intE = 1 To Len(senton)
If InStr(1, "\/|*?", Mid(senton, intE, 1)) > 0 Then
Mid(senton, intE, 1) = "-"
End If
Next intE

For intF = 1 To Len(senttime)
If InStr(1, "\:/|*?", Mid(senttime, intF, 1)) > 0 Then
Mid(senttime, intF, 1) = "."
End If
Next intF

' add date to file name
strMsgSubj = senton & " " & senttime & " " & "[To " & strMsgTo & "]" & " " & strMsgSubj & ".msg"
msgItem.SaveAs strPath & strMsgSubj

If UserForm1.TextBox3.Value = "YES" Then
Set msgItem.SaveSentMessageFolder = _
Session.GetDefaultFolder(olFolderDeletedItems)
End If

Set msgItem = Nothing
UserForm3.Hide
End Sub
 
I've just tried it again and whilst the user form loads when I click the button to send and save the MSG which runs the code above, it is the original message that is being saved
 
With ActiveExplorer
For lngC = 1 To .Selection.Count
Set msgItem = .Selection.Item(lngC)
If .Selection(lngC).Class = olMail Then
MsgSaverTest strPath, .Selection(lngC)
i think this is the problem - it's picking up the selection, not the reply. You'd only need that if you were saving a bunch of messages already in the folder.

Are you using this same macro with new messages? The macro that works for new messages should also work with replies.
 
I use the same code on another userform to save messages that are selected in a folder although I have changed the macro and sub names in the other code. If I REM those lines of code out then nothing happens. I get no errors but the message isn't sent or saved. The userform stays open so it suggests the code isn't getting processed.
 
what code do you use for new messages?
 
With ItemSend you must have a mailitem open.

If you only open the userform from ItemSend this should pick up the item being sent.

Public Sub SaveSent2_test()

Dim strPath As String

On Error Resume Next
strPath = UserForm3.TextBox1.Value
On Error GoTo 0
If strPath = "" Then Exit Sub

If Right(strPath, 1) <> "\" Then strPath = strPath & "\"

' save active open message
If ActiveInspector.currentItem.Class = olMail Then
MsgSaverTest strPath, ActiveInspector.currentItem
End If

End Sub


If you also open the userform outside of ItemSend put the test for an open item first.

Public Sub SaveSent2_test()
Dim lngC As Long
'Dim msgItem As MailItem
Dim strPath As String

On Error Resume Next

strPath = UserForm3.TextBox1.Value
On Error GoTo 0
If strPath = "" Then Exit Sub

If Right(strPath, 1) <> "\" Then strPath = strPath & "\"

If Inspectors.count Then

' save active open message
If ActiveInspector.currentItem.Class = olMail Then
MsgSaverTest strPath, ActiveInspector.currentItem
End If

ElseIf TypeName(Application.ActiveWindow) = "Explorer" Then

' save selected messages in Explorer window
If CBool(ActiveExplorer.Selection.count) Then
With ActiveExplorer
For lngC = 1 To .Selection.count
'Set msgItem = .Selection.item(lngC)
If .Selection(lngC).Class = olMail Then
MsgSaverTest strPath, .Selection(lngC)
End If
Next lngC
End With
End If

End If

End Sub
 
Niton,
Unfortunately this doesn't work. If I try and use your code when sending a new email, it works to an extent but actually saves the message as an unsent message in MSG format. What I really need is to save the sent message in MSG format. Also when I try and forward or reply to an email from my inbox and use your code it is saving the top email in my inbox (when sorted by most recent date) although sending the correct email.

I'm coming to the conclusion that I need to change my approach and have code that is executed after the sent message lands in the sent items folder...problem is this is my first attempt at writing code and therefore not up to speed on what can and can't be done and how to write code.
Thanks for your help
[DOUBLEPOST=1433507800][/DOUBLEPOST]
what code do you use for new messages?
Diane, i've just realised the code I was using on new mail items was saving the email in MSG format as an unsent message which isn't what I want. I want to save the sent message in MSG format
 
What I really need is to save the sent message in MSG format.
You need to save it after it is added to the sent items folder. Use an itemadd macro to watch the sent folder.


Code:
Private WithEvents Items As Outlook.Items

Private Sub Application_Startup()
Dim Ns As Outlook.NameSpace
 Set Ns = Application.GetNamespace("MAPI")
'use the default folder 
Set Items = Ns.GetDefaultFolder(olFolderSentItems).Items
End Sub

Private Sub Items_ItemAdd(ByVal Item As Object)
' put your code here
End Sub
 
OK so I use this code to open my userform, and then the relevant button can use the SaveSent2_test() code above, but I will need to amend that to select the item that has been added to the sent item folder. How do I do that?
[DOUBLEPOST=1433512962][/DOUBLEPOST]I alsi have some code that checks for missing attachments etc that is triggered using pplication_ItemSend. Since you can only have one of these in the ThisOutlookSession, is it possible to combine them?
 
Re: multiple itemadds: you can combine the code or call one macro then the other. But you won't combine an item send with an item add - the item send checks the message as it is sent, not after it hits the sent folder.


As soon as you send and item and it hits the sent folder, the macro kicks in and applies to that item.
 
Diane, the problem is I am intercepting the process by opening a userform when the item hits the sent items and I then have different macros to run from buttons on the userform so I need these macros to be ale to be applied to the items that's hit the sent items folder
 
You need to save it after it is added to the sent items folder. Use an itemadd macro to watch the sent folder.


Code:
Private WithEvents Items As Outlook.Items
 
Private Sub Application_Startup()
Dim Ns As Outlook.NameSpace
Set Ns = Application.GetNamespace("MAPI")
'use the default folder
Set Items = Ns.GetDefaultFolder(olFolderSentItems).Items
End Sub
 
Private Sub Items_ItemAdd(ByVal Item As Object)
' put your code here
End Sub

Diane, I have pasted the code above into ThisOutlookSession and when I startup outlook I get a runtime error and the debugger highlights the following line of code:

Set Items = Ns.GetDefaultFolder(olFolderSentItems).Items

Any thoughts?
 
I have solved this issue. The olFolderSentItems should actually be olFolderSentMail. However I still have the problem of selecting the item that was added to the sent items folder and then running a macro on this item
 
I'm fully sorted by using the sort function, sorting by ascending senton date and then selecting the first item
 
Pass the item in a public variable.

In a regular module
Public sentMailNewMail as Mailitem


Private Sub olSentItems_ItemAdd(ByVal Item As Object)
If TypeOf Item Is MailItem Then
Set sentMailNewMail = Item
UserForm1.Show
End If
End Sub


Userform 1
Private Sub CommandButton1_Click()
MsgBox sentMailNewMail.Subject
End Sub
 
Status
Not open for further replies.
Similar threads
Thread starter Title Forum Replies Date
J Help Please!!! Outlook 2016 - VBA Macro for replying with attachment in meeting invite Outlook VBA and Custom Forms 9
S VBA Macro - Run-time error '424': object required - Help Please Outlook VBA and Custom Forms 3
R VBA Macro to VBScript in a form- Help Please! Using Outlook 10
FryW Need help modifying a VBA script for in coming emails to auto set custom reminder time Outlook VBA and Custom Forms 0
N Help creating a VBA macro with conditional formatting to change the font color of all external emails to red Outlook VBA and Custom Forms 5
Y Filter unread emails in a search folder vba help Outlook VBA and Custom Forms 0
L Need help modifying a VBA script for emails stuck in Outbox Outlook VBA and Custom Forms 6
R Help Revising VBA macro to delete email over different time span Outlook VBA and Custom Forms 0
M Help sending email but removing signature via VBA Outlook VBA and Custom Forms 5
B VBA Help Email that will save as draft and send as attachment Outlook VBA and Custom Forms 3
J Need Help with Contacts VBA Outlook VBA and Custom Forms 1
G Message template / custom forms and VBA Help needed - inserting info into table Outlook VBA and Custom Forms 3
M VBA SWcript Help Required Using Outlook 1
R [VBA] complicated(?) outlook events - need help with code Using Outlook 15
F No Attachment Warning - VBA Code HELP Outlook VBA and Custom Forms 1
S Outlook Email Help: Select custom voting button options VBA Outlook VBA and Custom Forms 1
S Email Help: Sending Outlook email from Excel VBA Outlook VBA and Custom Forms 6
C Beginner Needs VBA Help in Modifying Code Outlook VBA and Custom Forms 2
P VBA help window: Multiple windows/tabs, bookmarks, bookmarks/historypane Outlook VBA and Custom Forms 4
S Custom Contact card - need help creating one Outlook VBA and Custom Forms 1
D Lifelong Windows user - new to Mac - Help!!! Using Outlook 3
L Help: set flag for sent mail to check if received an answer Outlook VBA and Custom Forms 2
Nufc1980 Outlook "Please treat this as private label" auto added to some emails - Help. Using Outlook 3
I Help with Smart Folder + Query Builder on IMAP Using Outlook 0
S Outlook 2002- "Send" button has disappeared. Help please. Using Outlook 1
A Outlook 2019 Help with forwarding email without mentioning the previous email sender. Outlook VBA and Custom Forms 0
Witzker Outlook 2019 HELP to get Template Path in a Function Outlook VBA and Custom Forms 2
CWM550 Outlook 365 HELP! Calendar Craziness! Using Outlook 5
S Outlook 365 Help me create a Macro to make some received emails into tasks? Outlook VBA and Custom Forms 1
e_a_g_l_e_p_i Has nobody used Office 2021 enough to help me or have you given up on me.......lol Using Outlook 1
X Open Hyperlinks in an Outlook Email Message (Help with Diane's solution) Outlook VBA and Custom Forms 3
L Help connecting to hosted exchange server 2016 Using Outlook 0
B Seeking help with Outlook rule Using Outlook 2
D Need help with MS Authenticator Using Outlook 4
I Outlook for Mac 2019 using on desktop and laptop IMAP on both need help with folders Using Outlook 1
S.Champ Please help? I've imported a random workcalendar I dont even know who's. Can I undo it? and then I need to re-sync the google one again. Its a mess:( Using Outlook 2
S HTML to Plain Text Macro - Help Outlook VBA and Custom Forms 1
e_a_g_l_e_p_i Outlook 2010 Help setting up Gmail account in Outlook 2010 Using Outlook 3
F Microsoft Outlook Connector 14.0.6123.5001 - Help! Using Outlook 6
Witzker Pls help to change the code for inserting date in Ol contact body Outlook VBA and Custom Forms 5
R Disable conversation thread from replying of recipients in the same subject. Please help Using Outlook 0
R seperate read layout to design in outlook 2016..Help!! Outlook VBA and Custom Forms 3
O Help .. got lost ... installing Office like 2016 Using Outlook 5
A Arthur needs help with 2007 Outlook e-mail Using Outlook.com accounts in Outlook 3
Marc2019 Need help please! Cannot Setup my outlook email account on my Mac Outlook 2011 Using Outlook.com accounts in Outlook 2
L Attachment saving and tracking - PLEASE help! Outlook VBA and Custom Forms 5
I Help with dates in task list. Using Outlook 5
C need help setting up outlook first time Using Outlook 1
K To do bar help Using Outlook 8
S help with outlook scripting Outlook VBA and Custom Forms 4

Similar threads

Back
Top