Untitled

mail@pastecode.io avatar
unknown
plain_text
a month ago
1.9 kB
1
Indexable
Never
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
Leave a Comment