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
 

Alan McGowan

Senior Member
Outlook version
Outlook 2013 64 bit
Email Account
Exchange Server
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
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
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.
 

Alan McGowan

Senior Member
Outlook version
Outlook 2013 64 bit
Email Account
Exchange Server
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.
 

niton

Member
Outlook version
Outlook 2010 32 bit
Email Account
Exchange Server 2010
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
 

Alan McGowan

Senior Member
Outlook version
Outlook 2013 64 bit
Email Account
Exchange Server
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
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
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
 

Alan McGowan

Senior Member
Outlook version
Outlook 2013 64 bit
Email Account
Exchange Server
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?
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
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.
 

Alan McGowan

Senior Member
Outlook version
Outlook 2013 64 bit
Email Account
Exchange Server
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
 

Alan McGowan

Senior Member
Outlook version
Outlook 2013 64 bit
Email Account
Exchange Server
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?
 

Alan McGowan

Senior Member
Outlook version
Outlook 2013 64 bit
Email Account
Exchange Server
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
 

Alan McGowan

Senior Member
Outlook version
Outlook 2013 64 bit
Email Account
Exchange Server
I'm fully sorted by using the sort function, sorting by ascending senton date and then selecting the first item
 

niton

Member
Outlook version
Outlook 2010 32 bit
Email Account
Exchange Server 2010
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
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
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
EmelineGueguen Help to understand the problem of work Using Outlook 1
N Outlook Forms Help Outlook VBA and Custom Forms 2
N Need help syncing contacts to iPhone X Using Outlook 8
broadbander Needing help with reply/reply all while keeping attachments and adding a new CC recipient. Outlook VBA and Custom Forms 5
J Help! My contacts have disappeared. Using Outlook 5
J HELP- Rule to auto strip prepend from external emails Using Outlook 0
J Help Needed With Multi-Step Login Email Address Using Outlook.com accounts in Outlook 1
G Bcc help - Preventing multiple forwards from a bcc'd distribution group Using Outlook 1
G [Help] Converting array to destination folder path Outlook VBA and Custom Forms 1
K Help.... Office Outlook 2016 Using Outlook 1
S Error using AddressEntry.GetContact - need help Outlook VBA and Custom Forms 2
D Help with code to move mail on receipt to another folder based on time received Outlook VBA and Custom Forms 2
EaglePI Outlook 2010 need help with rules Using Outlook 0
B HELP! Using Outlook 4
Jeff Davis Help fix my Outlook 2013? Using Outlook 28
M Winmail. dat - HELP Using Outlook 2
Diane Poremsky Help! My Contacts are being updated! New Slipstick.com Articles 0
J Can Anyone Help?? Outlook VBA and Custom Forms 1
C Newbie needs help with Outlook Macro Outlook VBA and Custom Forms 3
B Need Help - Willing to pay Outlook VBA and Custom Forms 10
D help with Item/Inspector close event Outlook VBA and Custom Forms 1
G Looking for help with our Organization Forms Library Outlook VBA and Custom Forms 1
L Outlook 2002: HTML Emails Will Not Print: Please Help Using Outlook 0
H Need help setting up GetFolderPath-Makro with Vodafone IMAP Mail-Account Outlook VBA and Custom Forms 0
A newb outlook macro help Outlook VBA and Custom Forms 1

Similar threads

Top