![]() |
#1
|
|||
|
|||
![]()
Hi guys
I've been working on this VBA that changes the 'From' address on selected drafts. It works, BUT let's say I have three drafts selected, then it's only doing it for the first draft of the selection, and not all of them. Any thoughts? Thanks a lot ![]() James Sub ChangeSenderOnSelectedDraftEmails() Dim xSelection As Selection Dim xPromptStr As String Dim xYesOrNo As Integer Dim i As Long Dim xNewMail As MailItem Dim xTmpPath, xFilePath As String On Error Resume Next If Outlook.Application.Session.GetDefaultFolder(olFol derDrafts).Name <> _ Outlook.Application.ActiveExplorer.CurrentFolder.N ame Then MsgBox "Please select drafts in the root draft folder, not a sub folder." Exit Sub End If Set xSelection = Outlook.Application.ActiveExplorer.Selection If xSelection.Count > 0 Then xPromptStr = "Are you sure to change the 'From' on the selected " & xSelection.Count & " draft item(s)?" xYesOrNo = MsgBox(xPromptStr, vbQuestion + vbYesNo) If xYesOrNo = vbYes Then For i = xSelection.Count To 1 Step -1 If i = 1 Then Set xNewMail = Outlook.Application.CreateItem(olMailItem) With xNewMail .SendUsingAccount = xSelection.Item(i).SendUsingAccount .To = xSelection.Item(i).To .SentOnBehalfOfName = "mynewaddress@test.com" .CC = xSelection.Item(i).CC .BCC = xSelection.Item(i).BCC .Subject = xSelection.Item(i).Subject If xSelection.Item(i).Attachments.Count > 0 Then xTmpPath = "C:\MyTempAttachments" If Dir(xTmpPath, vbDirectory) = "" Then MkDir xTmpPath End If For k = xSelection.Item(i).Attachments.Count To 1 Step -1 xFilePath = xTmpPath & "" & xSelection.Item(i).Attachments.Item(k).FileName xSelection.Item(i).Attachments.Item(k).SaveAsFile xFilePath xNewMail.Attachments.Add (xFilePath) Kill xFilePath Next k RmDir xTmpPath End If .HTMLBody = xSelection.Item(i).HTMLBody .Save End With xSelection.Item(i).Delete Else xSelection.Item(i).Save End If Next MsgBox "Successfully changed 'From' on " & xSelection.Count & " messages" End If Else MsgBox "No drafts selected!" End If End Sub |
|
![]() |
||||
Thread | Thread Starter | Forum | Replies | Last Post |
Outlook rule to move emails from drafts into a draft subfolder | gazmoz17 | Outlook | 0 | 10-03-2019 06:34 AM |
word 2016 won't change to drafts for default view | infonutt | Word | 0 | 07-21-2017 10:31 AM |
![]() |
Bansaw | Outlook | 2 | 07-28-2011 08:45 AM |
autosaving drafts with digital signature in outlook 2010 | lvovich | Outlook | 0 | 04-11-2011 12:40 AM |
Sent Items in Saved in Drafts | trish@25by7.com | Outlook | 1 | 11-05-2010 02:33 AM |