Как ограничить длину имени файла максимально допустимой?

Когда я пытаюсь отправить электронное письмо 30 получателям и группе из 60 получателей, возникает ошибка:

Run-time error '-2147286788 (800300fc)

Item.SaveAs sPath & sName, olMSG - вот в чем проблема.

В коде есть комментарий Snameможет потребоваться ограничение длины символа.

Я думаю, что код пытается создать имя файла из темы электронного письма, времени и даты, а также имен электронной почты получателей, и в имени файла слишком много символов.

Полный код ниже. Он находится в модуле ThisOutlookSession.

Option Explicit
Private WithEvents Items As Outlook.Items
Private WithEvents SentItems As Outlook.Items

Private Sub Application_Startup()
Dim Ns As Outlook.NameSpace
Set Ns = Application.GetNamespace("MAPI")
Set Items = Ns.GetDefaultFolder(olFolderInbox).Items
Set SentItems = Ns.GetDefaultFolder(olFolderSentMail).Items
End Sub

Private Sub Items_ItemAdd(ByVal Item As Object)
If TypeOf Item Is Outlook.MailItem Then

Dim sPath As String
Dim dtDate As Date
Dim sName As String
Dim enviro As String

enviro = CStr(Environ("USERPROFILE"))

sName = Item.Subject & "-" & Item.SenderName
ReplaceCharsForFileName sName, "_"

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

sPath = enviro & "\Email\Inbox\"
Debug.Print sPath & sName
Item.SaveAs sPath & sName, olMSG

End If

End Sub

Private Sub SentItems_ItemAdd(ByVal Item As Object)
If TypeOf Item Is Outlook.MailItem Then

Dim sPath As String
Dim dtDate As Date
Dim sName As String
Dim enviro As String

enviro = CStr(Environ("USERPROFILE"))

'Save name is the email subject plus who the email was sent to
sName = Item.Subject & "-" & Item.To 'might need restricting character length
ReplaceCharsForFileName sName, "_"

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

sPath = enviro & "\Email\Sent Items\"
Debug.Print sPath & sName
Item.SaveAs sPath & sName, olMSG

End If

End Sub


Private Sub ReplaceCharsForFileName(sName As String, _
sChr As String _
)
sName = Replace(sName, "/", sChr)
sName = Replace(sName, "\", sChr)
sName = Replace(sName, ":", sChr)
sName = Replace(sName, "?", sChr)
sName = Replace(sName, Chr(34), sChr)
sName = Replace(sName, "<", sChr)
sName = Replace(sName, ">", sChr)
sName = Replace(sName, "|", sChr)
End Sub