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