如何将文件名长度限制在最大允许范围内?

时间:2018-07-19 18:57:51

标签: vba email outlook-vba

当我尝试向30位收件人和一组60位收件人发送电子邮件时,出现错误:

  

运行时错误'-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

1 个答案:

答案 0 :(得分:0)

为简单起见,假设限制为250个字符。

按日期长度减少:

Len(Format(dtDate, "yyyymmdd", vbUseSystemDayOfWeek, _
  vbUseSystem) & Format(dtDate, "-hhnnss", _
  vbUseSystemDayOfWeek, vbUseSystem))

按路径长度减少:

Len(enviro & "\Email\Sent Items\")

假设上面的两个数字加起来为100。剩余150个字符。

一个简单的解决方法是:

'Save name is the email subject plus who the email was sent to
'sName = Item.Subject & "-" & Item.To
sName = left(Item.Subject, 50)  & "-" & left(Item.To, 99)

更通用的解决方案包括根据其他人的环境长度不同,动态计算50和99。