Run-time error '-2147024882 (8007000e)'

[Adam81]

I am trying to put together a project to save e-mails to a folder. After 51 e-mails are saved to .../MyEmails I am getting the error below:
Run-time error '-2147024882 (8007000e)'

There is not enough free memory to run this program. Quit one or more programs, and then try again.

So I increased my virtual memory from 1280MB to 4000MB and I get the same error message (after 51 e-mails are saved).


Option Explicit
Public Sub SaveMessageAsMsg()
Dim oMail As Outlook.MailItem
Dim objItem As Object
Dim sPath As String
Dim dtDate As Date
Dim sName As String
Dim enviro As String

enviro = CStr(Environ("USERPROFILE"))
sPath = enviro & "\Documents\MyEmails\"

For Each objItem In ActiveExplorer.Selection
If objItem.MessageClass = "IPM.Note" Then
Set oMail = objItem

'get name and remove special characters
sName = oMail.Subject
sName = Replace(sName, "'", "-")
sName = Replace(sName, "*", "-")
sName = Replace(sName, "/", "-")
sName = Replace(sName, "\", "-")
sName = Replace(sName, ":", "-")
sName = Replace(sName, "?", "-")
sName = Replace(sName, Chr(34), "-")
sName = Replace(sName, "<", "-")
sName = Replace(sName, ">", "-")
sName = Replace(sName, "|", "-")

dtDate = oMail.ReceivedTime
sName = Format(dtDate, "yyyymmdd", vbUseSystemDayOfWeek, _
vbUseSystem) & Format(dtDate, "-hhnnss", _
vbUseSystemDayOfWeek, vbUseSystem) & "-" & sName & ".msg"

oMail.SaveAs sPath & sName, olMSG
End If
Next
End Sub
I am using Outlook 2013, Windows 10 Pro V 1709.

Thanks
Adam

[gmayor]

A couple of small changes might help - but I would suggest that you investigate the message it stops at to see why that should be.

Public Sub SaveMessageAsMsg()
Dim oMail As Outlook.MailItem
Dim objItem As Object
Dim sPath As String
Dim dtDate As Date
Dim sName As String
Dim enviro As String

enviro = CStr(Environ("USERPROFILE"))
sPath = enviro & "\Documents\MyEmails\"

For Each objItem In ActiveExplorer.Selection
If objItem.MessageClass = "IPM.Note" Then
Set oMail = objItem

'get name and remove special characters
sName = Left(oMail.Subject, 100) 'limit the length of the subject
sName = Replace(sName, "'", "-")
sName = Replace(sName, "*", "-")
sName = Replace(sName, "/", "-")
sName = Replace(sName, "\", "-")
sName = Replace(sName, ":", "-")
sName = Replace(sName, "?", "-")
sName = Replace(sName, Chr(34), "-")
sName = Replace(sName, "<", "-")
sName = Replace(sName, ">", "-")
sName = Replace(sName, "|", "-")

dtDate = oMail.ReceivedTime
sName = Format(dtDate, "yyyymmdd", vbUseSystemDayOfWeek, _
vbUseSystem) & Format(dtDate, "-hhnnss", _
vbUseSystemDayOfWeek, vbUseSystem) & "-" & sName & ".msg"

oMail.SaveAs sPath & sName, olMsg
End If
DoEvents
Next
Set oMail = Nothing
Set objItem = Nothing
End Sub


I have just tested the following with 3500+ messages and it worked OK - try this one first.


Public Sub TestMessageAsMsg()
Dim oMail As Outlook.MailItem
Dim objItem As Object
Dim sPath As String
Dim dtDate As Date
Dim sName As String
Dim enviro As String
Dim i As Long: i = 0

enviro = CStr(Environ("USERPROFILE"))
sPath = enviro & "\Documents\MyEmails\"

For Each objItem In ActiveExplorer.Selection
If objItem.MessageClass = "IPM.Note" Then
i = i + 1
Set oMail = objItem

'get name and remove special characters
sName = Left(oMail.Subject, 100) 'limit the length of the subject
sName = Replace(sName, "'", "-")
sName = Replace(sName, "*", "-")
sName = Replace(sName, "/", "-")
sName = Replace(sName, "\", "-")
sName = Replace(sName, ":", "-")
sName = Replace(sName, "?", "-")
sName = Replace(sName, Chr(34), "-")
sName = Replace(sName, "<", "-")
sName = Replace(sName, ">", "-")
sName = Replace(sName, "|", "-")

dtDate = oMail.ReceivedTime
sName = Format(dtDate, "yyyymmdd", vbUseSystemDayOfWeek, _
vbUseSystem) & Format(dtDate, "-hhnnss", _
vbUseSystemDayOfWeek, vbUseSystem) & "-" & sName & ".msg"

Debug.Print sPath & sName & vbTab & i

End If
DoEvents
Next
Set oMail = Nothing
Set objItem = Nothing
End Sub

[Adam81]

Thank you for the input, the Debug.Print helped me find the message it was stopping at. Unfortunately I don't see anything unique about that e-mail. For the time being I moved the suspect e-mail to a different location, now I am able to save 205 e-mail, but 239 e-mails are selected in outlook. The debug line registers e-mail 206, but the VBA stops there, no error message or anything unique.

On a side note, I added the oMail.SaveAs sPath & sName, olMSG line back in, just after the debug line.


Public Sub TestMessageAsMsg()
Dim oMail As Outlook.MailItem
Dim objItem As Object
Dim sPath As String
Dim dtDate As Date
Dim sName As String
Dim enviro As String
Dim i As Long: i = 0


enviro = CStr(Environ("USERPROFILE"))
sPath = enviro & "\Documents\MyEmails\"


For Each objItem In ActiveExplorer.Selection
If objItem.MessageClass = "IPM.Note" Then
i = i + 1
Set oMail = objItem


'get name and remove special characters
sName = Left(oMail.Subject, 100) 'limit the length of the subject
sName = Replace(sName, "'", "-")
sName = Replace(sName, "*", "-")
sName = Replace(sName, "/", "-")
sName = Replace(sName, "\", "-")
sName = Replace(sName, ":", "-")
sName = Replace(sName, "?", "-")
sName = Replace(sName, Chr(34), "-")
sName = Replace(sName, "<", "-")
sName = Replace(sName, ">", "-")
sName = Replace(sName, "|", "-")


dtDate = oMail.ReceivedTime
sName = Format(dtDate, "yyyymmdd", vbUseSystemDayOfWeek, _
vbUseSystem) & Format(dtDate, "-hhnnss", _
vbUseSystemDayOfWeek, vbUseSystem) & "-" & sName & ".msg"

Debug.Print sPath & sName & vbTab & i
oMail.SaveAs sPath & sName, olMSG


End If
DoEvents
Next
Set oMail = Nothing
Set objItem = Nothing
End Sub

[skatonni]

Possibly some of the selection fail the MessageClass test.

Try an else like this


Else

notIPMNoteCount = notIPMNoteCount + 1
Debug.Print " notIPMNote: " & notIPMNote

[Adam81]

skatonni, you are correct of the 239 e-mails selected 34 are not "IPM.Note". This begs the question, how do I save none "IPM.Note" Message Class'?

I tried removing the MessageClass test and I get an error message...

Thanks
Adam

[gmayor]

The following will identify the message class. Class 43 is MailItem. The various classes are listed at https://docs.microsoft.com/en-us/dotnet/api/microsoft.office.interop.outlook.olobjectclass?view=outlook-pia. As the items in question are not mail items then don't bother with setting a mailitem variable e.g.

Set oMail = objItem

as you have already identified the message as objItem. Process the objItem object directly.


Public Sub TestMessageAsMsg()
Dim objItem As Object
Dim i As Long: i = 0

For Each objItem In ActiveExplorer.Selection
i = i + 1
If objItem.Class <> 43 Then
Debug.Print i & vbTab & objItem.Subject & vbTab & objItem.Class
End If
DoEvents
Next
Set objItem = Nothing
End Sub