Click here to Skip to main content
14,486,704 members
Rate this:
Please Sign up or sign in to vote.
See more:
I have been using the code below to save outlook messages and attachments for some years. The company has decided to upgrade from Win 7 and Office 2013 to Win 10 and Office 365. Now the interop saveas function no longer works. If fails with the error :
Quote:
Operation aborted (Exception from HRESULT: 0x80004004 (E_ABORT))

I drag and drop the email from Outlook onto a textbox. The filename is displayed in the textbox and the email/attachment is copied to a folder on the local drive.

Here is the code:
Imports Microsoft.Office.Interop.Outlook

Public Class Form1

    Private Sub TextBox1_DragEnter(ByVal sender As Object, ByVal e As System.Windows.Forms.DragEventArgs) Handles TextBox1.DragEnter
        If e.Data.GetDataPresent(DataFormats.FileDrop) Or e.Data.GetDataPresent("FileGroupDescriptor") Then
            e.Effect = DragDropEffects.Copy
        End If
    End Sub

    Private Sub TextBox1_DragDrop(sender As Object, e As DragEventArgs) Handles TextBox1.DragDrop
        Dim strDestinationPath As String = "c:\ProgramData\temp"
        Dim strDestinationFile As String
        Dim strFilename As String = ""

        If Not IO.Directory.Exists("c:\ProgramData\temp") Then IO.Directory.CreateDirectory("c:\ProgramData\temp")

        If e.Data.GetDataPresent("FileGroupDescriptor") Then
            'Get the name of the dragged file/message
            Dim theStream As IO.Stream = DirectCast(e.Data.GetData("FileGroupDescriptor"), IO.Stream)
            Dim fileGroupDescriptor As Byte() = New Byte(511) {}
            theStream.Read(fileGroupDescriptor, 0, 512)

            Dim fileName As New System.Text.StringBuilder("")
            Dim i As Integer = 76
            While fileGroupDescriptor(i) <> 0
                fileName.Append(Convert.ToChar(fileGroupDescriptor(i)))
                i += 1
            End While
            theStream.Close()

            strFilename = fileName.ToString
        End If

        'Check if user dragged the Message or Attachment
        If IO.Path.GetExtension(strFilename).ToUpper = ".MSG" Then

            'Message dragged and dropped
            Dim objMI As MailItem
            Dim objOL As New Application

            For Each objMI In objOL.ActiveExplorer.Selection()
                strFilename = RemoveIllegalChar(objMI.Subject) & ".msg"
                strDestinationFile = IO.Path.Combine(strDestinationPath, strFilename)

                If IO.File.Exists(strDestinationFile) Then
                    MsgBox(strFilename & " Is already In this folder" & vbCrLf & "COPY ABORTED", MsgBoxStyle.Exclamation)
                Else
                    Try
                        TextBox1.Text = strFilename
           
                        '**** FAILS AT THIS POINT ****
                        '*****************************
                        objMI.SaveAs(strDestinationFile, OlSaveAsType.olMSG)
                        'Check file copied OK then add to Attachment Table and File List
                    Catch ex As System.Exception
                        MsgBox("Error copying email", MsgBoxStyle.Exclamation)
                        Exit Sub
                    End Try
                End If

                MsgBox("Success, email copied OK", MsgBoxStyle.Exclamation)

            Next

        Else
            'Check if File/Message already exists
            strDestinationFile = IO.Path.Combine(strDestinationPath, strFilename)

            If IO.File.Exists(strDestinationFile) Then
                MsgBox(strFilename & " Is already In this folder" & vbCrLf & "COPY ABORTED", MsgBoxStyle.Exclamation)
            End If
            Try

                Dim ms As IO.MemoryStream = DirectCast(e.Data.GetData("FileContents", True), IO.MemoryStream)
                Dim fileBytes As Byte() = New Byte(CInt(ms.Length - 1)) {}
                ms.Position = 0
                ms.Read(fileBytes, 0, CInt(ms.Length))

                Dim fs As New IO.FileStream(strDestinationFile, IO.FileMode.Create)
                fs.Write(fileBytes, 0, CInt(fileBytes.Length))

                fs.Close()
                TextBox1.Text = strFilename
            Catch ex As system.Exception
                MsgBox("Error copying attachment file", MsgBoxStyle.Exclamation)
                Exit Sub
            End Try

            MsgBox("Success, attachment file copied OK", MsgBoxStyle.Exclamation)

        End If


    End Sub

    Friend Function RemoveIllegalChar(ByVal StringToCheck As String) As String
        '=======================================================================
        'purpose: Eliminate characters that are not allowed in file/folder name
        '=======================================================================
        Dim sIllegal As String = "\,/,:,*,?,<,>,|,~," & Chr(34)
        Dim arIllegal() As String = Split(sIllegal, ",")
        Dim sReturn As String = ""
        'Dim strString2 As String

        'sReturn = StringToCheck
        'Remove all characters above 127 ascii and place result imto sReturn
        For Each c As Char In StringToCheck
            sReturn = sReturn & IIf(Asc(c) > 127, "_", c)
        Next

        For i = 0 To arIllegal.Length - 1
            sReturn = Replace(sReturn, arIllegal(i), "_")
        Next

        'Remove leading spaces and return
        Return sReturn.TrimStart
    End Function


What I have tried:

I stripped the code from my project to a simple project - see below. The error remained. I have searched the net for similar problems.
Posted
Updated 23-Mar-20 15:37pm
Comments
Maciej Los 1-May-18 15:13pm
   
What line produces such of error message?
ZurdoDev 23-Mar-20 10:43am
   
What he said. ^ You need to know which line of code is causing the error.

1 solution

Rate this:
Please Sign up or sign in to vote.

Solution 2

This is where it fails - when it tried to save the file.

objMI.SaveAs(strDestinationFile, OlSaveAsType.olMSG)

The problem however, has since been resolved. The failure was caused by an outlook group policy that was applied to all users. I do not know which policy caused the error as the policies are controlled by a different group (this is a corporate environment).

I requested all Outlook policies to be removed and everything worked as expected.
   

This content, along with any associated source code and files, is licensed under The Code Project Open License (CPOL)




CodeProject, 503-250 Ferrand Drive Toronto Ontario, M3C 3G8 Canada +1 416-849-8900 x 100