George Papaikonomou
New Member
- Outlook version
- Outlook 2016 64 bit
- Email Account
- IMAP
Hi,
I am writing a VBA script to create a new from a draft email - yes I know I can save it as a template and use it that way - but that is not what I want.
Below is the code.
The draft has a series of embedded gif images.
The scirpt kind of works , it creates the new email but the embedded gif are missing.
How can I copy them as well - replicate the draft to a new email message?
I am writing a VBA script to create a new from a draft email - yes I know I can save it as a template and use it that way - but that is not what I want.
Below is the code.
The draft has a series of embedded gif images.
The scirpt kind of works , it creates the new email but the embedded gif are missing.
How can I copy them as well - replicate the draft to a new email message?
Sub Draft2Mail()
Dim x As Integer
Dim objOL As Outlook.Application
Dim objSelection As Outlook.Selection
Dim objItem As Object
Set objOL = Outlook.Application
'Get the selected item
Select Case TypeName(objOL.ActiveWindow)
Case "Explorer"
Set objSelection = objOL.ActiveExplorer.Selection
If objSelection.Count > 0 Then
Set objItem = objSelection.item(1)
Else
Result = MsgBox("No item selected. " & _
"Please make a selection first.", _
vbCritical, "Draft2Mail")
Exit Sub
End If
Case "Inspector"
Set objItem = objOL.ActiveInspector.CurrentItem
Case Else
Result = MsgBox("Unsupported Window type." & _
vbNewLine & "Please make a selection" & _
"in the Draft folder or open an item first.", _
vbCritical, "Draft2Mail")
Exit Sub
End Select
Dim olDraft As Outlook.MailItem
Dim olNewMail As Outlook.MailItem
Dim myAttachments As Outlook.Attachments
Set olNewMail = Outlook.CreateItem(olMailItem)
'Copy the desired details to a new email item
If objItem.Class = olMail Then
Set olDraft = objItem
Debug.Print olDraft.Attachments.Count
With olNewMail
.To = olDraft.To
.CC = olDraft.CC
.BCC = olDraft.BCC
.Importance = olDraft.Importance
.Subject = olDraft.Subject
.HTMLBody = olDraft.HTMLBody
'.Attachments = olDraft.Attachments '<-- This does not work..
End With
'Display the copy
olNewMail.Display
Else
Result = MsgBox("No draft email item selected. " & _
"Please make a selection first.", _
vbCritical, "Draft2Mail")
Exit Sub
End If
'Clean up
Set objOL = Nothing
Set objItem = Nothing
Set olNewMail = Nothing
Set olDraft = Nothing
End Sub
Dim x As Integer
Dim objOL As Outlook.Application
Dim objSelection As Outlook.Selection
Dim objItem As Object
Set objOL = Outlook.Application
'Get the selected item
Select Case TypeName(objOL.ActiveWindow)
Case "Explorer"
Set objSelection = objOL.ActiveExplorer.Selection
If objSelection.Count > 0 Then
Set objItem = objSelection.item(1)
Else
Result = MsgBox("No item selected. " & _
"Please make a selection first.", _
vbCritical, "Draft2Mail")
Exit Sub
End If
Case "Inspector"
Set objItem = objOL.ActiveInspector.CurrentItem
Case Else
Result = MsgBox("Unsupported Window type." & _
vbNewLine & "Please make a selection" & _
"in the Draft folder or open an item first.", _
vbCritical, "Draft2Mail")
Exit Sub
End Select
Dim olDraft As Outlook.MailItem
Dim olNewMail As Outlook.MailItem
Dim myAttachments As Outlook.Attachments
Set olNewMail = Outlook.CreateItem(olMailItem)
'Copy the desired details to a new email item
If objItem.Class = olMail Then
Set olDraft = objItem
Debug.Print olDraft.Attachments.Count
With olNewMail
.To = olDraft.To
.CC = olDraft.CC
.BCC = olDraft.BCC
.Importance = olDraft.Importance
.Subject = olDraft.Subject
.HTMLBody = olDraft.HTMLBody
'.Attachments = olDraft.Attachments '<-- This does not work..
End With
'Display the copy
olNewMail.Display
Else
Result = MsgBox("No draft email item selected. " & _
"Please make a selection first.", _
vbCritical, "Draft2Mail")
Exit Sub
End If
'Clean up
Set objOL = Nothing
Set objItem = Nothing
Set olNewMail = Nothing
Set olDraft = Nothing
End Sub