Untitled
unknown
plain_text
a year ago
1.9 kB
3
Indexable
Option Explicit Sub Send_to_edoc() ' Show the UserForm UserForm1.Show End Sub Sub ProcessReferences(selectedCategory As String, selectedOptions As String, references As String) Dim objApp As Outlook.Application Dim objNamespace As Outlook.NameSpace Dim objFolder As Outlook.MAPIFolder Dim objItem As Outlook.mailItem Dim objMailItem As Outlook.mailItem Dim arrReferences As Variant Dim reference As String ' Get selected email from Inbox Set objApp = New Outlook.Application Set objNamespace = objApp.GetNamespace("MAPI") Set objFolder = objNamespace.GetDefaultFolder(6) ' 6 = olFolderInbox On Error Resume Next ' OLD CODE Set objItem = objFolder.Items.Item(Application.activeExplorer.Selection(1).Index) Set objItem = objApp.ActiveExplorer.Selection.item(1) On Error GoTo 0 If objItem Is Nothing Then MsgBox "No email selected. Exiting.", vbExclamation Exit Sub End If ' Split references into an array arrReferences = Split(references, vbCrLf) ' Process each reference Dim ref As Variant For Each ref In arrReferences ' Create new mail item Set objMailItem = objApp.CreateItem(0) ' olMailItem = 0 ' Set the recipient's email address objMailItem.To = " add email " ' Attach selected email as .msg file objItem.SaveAs Environ("TEMP") & "\" & "SelectedEmail.msg" objMailItem.Attachments.Add Environ("TEMP") & "\" & "SelectedEmail.msg" Kill Environ("TEMP") & "\" & "SelectedEmail.msg" ' Set email subject objMailItem.Subject = "[EdiDocManager " & selectedCategory & " " & selectedOptions & " " & ref & "]" ' Send the email objMailItem.Send Next ref ' Hide the UserForm UserForm1.Hide End Sub
Editor is loading...
Leave a Comment