none
Переслать письмо как вложение RRS feed

  • Общие обсуждения

  • Сразу прошу прощенья у модераторов просто не в том месте разместил сообщения, поэтому дублирую в правильный раздел сюда.

    Необходимо входящие письмо переслать на другой аккуант, как вложение  и иногда сохранять в папку на жесткий диск. Главная проблема переслать, а сохранять можно и в ручную вот пример скрипта, данный вариант свободно работал как макрос.

    Private Sub Button1_Click(sender As Object, e As RibbonControlEventArgs) Handles Button1.Click
    
            Dim objItem As Outlook.MailItem
            Dim objMsg As Outlook.MailItem
    
    
            On Error Resume Next
    
            If Globals.ThisAddIn.Application.ActiveExplorer.Selection.Count = 0 Then
    
                MsgBox("No item selected")
    
                Exit Sub
    
            End If
    
            For Each objItem In Globals.ThisAddIn.Application.ActiveExplorer.Selection
                objMsg = Globals.ThisAddIn.Application.CreateItem(Outlook.OlItemType.olMailItem)
                With objMsg
                    .To = "user@domain.ru"
                    .Subject = "doccy"
                    .Attachments.Add(objItem, Outlook.OlAttachmentType.olEmbeddeditem)
                    .Send()
                End With
                objItem.Delete()
            Next
    
            objItem = Nothing
            objMsg = Nothing
    
        End Sub

    На английском форуме помогли и привели к следующему варианту:

    Sub DoccyToFolder()
            On Error Resume Next
    
            Dim objItem As Outlook.MailItem
            Dim objMsg As Outlook.MailItem
            Dim app As Outlook.Application
            Dim exp As Outlook.Explorer
            Dim sel As Outlook.Selection
    
            Dim attachments As Outlook.Attachments
            Dim objOutlookAtt As Outlook.Attachment
    
            app = Globals.ThisAddIn.Application
            exp = app.ActiveExplorer()
            sel = exp.Selection
    
    
            If sel.Count = 0 Then
                MsgBox("No item selected")
                Exit Sub
            End If
    
            Dim i As Integer
    
            For i = sel.Count To 1 Step -1
    
                Try
                    objMsg = CType(sel.Item(i), Outlook.MailItem)
    
                    objItem = objMsg.Copy()
    
                    'objItem = objMsg.Forward()'
    
                    attachments = objItem.Attachments
    
                    objOutlookAtt = attachments.Add(objMsg, Outlook.OlAttachmentType.olEmbeddeditem)
    
                    objItem.Subject = "doccy"
                    objItem.To = "user@domain.ru"
                    objItem.Send()
                Finally
                    If Not objOutlookAtt Is Nothing Then
                        System.Runtime.InteropServices.Marshal.ReleaseComObject(objOutlookAtt)
                        objOutlookAtt = Nothing
                    End If
                    If Not attachments Is Nothing Then
                        System.Runtime.InteropServices.Marshal.ReleaseComObject(attachments)
                        attachments = Nothing
                    End If
                    If Not objMsg Is Nothing Then
                        System.Runtime.InteropServices.Marshal.ReleaseComObject(objMsg)
                        objMsg = Nothing
                    End If
                    If Not objItem Is Nothing Then
                        System.Runtime.InteropServices.Marshal.ReleaseComObject(objItem)
                        objItem = Nothing
                    End If
                End Try
            Next
    
            System.Runtime.InteropServices.Marshal.ReleaseComObject(sel)
            System.Runtime.InteropServices.Marshal.ReleaseComObject(exp)
    
            MsgBox("Mail Sent!", vbOKOnly, "Mail Sent")
    
        End Sub

    В этом случаи при сборке ругается на "On Error Resume Next", соответственно удаляю по спецификации направленной ответчиком  на анг. форуме, прочитал вроде как понял. И то что там написано мне никак не помогает. Однако, дальше идут ошибки:

    Предупреждение	1	Переменная "objOutlookAtt" используется до присвоения ей значения. Во время выполнения может произойти исключение при ссылке на значение NULL.	f:\visualstudio\Projects\OutlookAddIn8\OutlookAddIn8\Module1.vb	45	24	OutlookAddIn8
    
    Предупреждение	2	Переменная "attachments" используется до присвоения ей значения. Во время выполнения может произойти исключение при ссылке на значение NULL.	f:\visualstudio\Projects\OutlookAddIn8\OutlookAddIn8\Module1.vb	49	24	OutlookAddIn8
    
    Предупреждение	3	Переменная "objMsg" используется до присвоения ей значения. Во время выполнения может произойти исключение при ссылке на значение NULL.	f:\visualstudio\Projects\OutlookAddIn8\OutlookAddIn8\Module1.vb	53	24	OutlookAddIn8
    
    
    Предупреждение	4	Переменная "objItem" используется до присвоения ей значения. Во время выполнения может произойти исключение при ссылке на значение NULL.	f:\visualstudio\Projects\OutlookAddIn8\OutlookAddIn8\Module1.vb	57	24	OutlookAddIn8
    

    Перелопатил с ног на голову весь скрипт, все повторяется.  Может кто помочь закончить данный скрипт ? Задача кажется настолько элементарной, что мучаюсь уже неделю.



    1 февраля 2014 г. 16:39