Sub olAddAttachedFileTitle() Dim mFileName, mSubject As String Dim iPos As Integer Dim i As Integer
Set CurrentMail = ActiveInspector.CurrentItem If TypeName(CurrentMail) <> "MailItem" Then MsgBox "当前活动窗口不是一封邮件" Else If CurrentMail.Attachments.Count > 0 Then '必须是在有附件的情况下 For Each Item In CurrentMail.Attachments mFileName = Item.FileName '取得附件文件名称(包括后缀) mLen = Len(mFileName) '取得名称长度 For i = mLen To 1 Step -1 If Mid(mFileName, i, 1) = "." Then iPos = i '.的位置 End If Next i iPos = iPos - 1 mFileName = Left(mFileName, iPos) '去掉了后缀的文件名称 If mSubject = "" Then mSubject = mFileName Else mSubject = mSubject & ", " & mFileName End If Next CurrentMail.Subject = mSubject '把得到的名称写入邮件主题 Else MsgBox "当前邮件没有附件" End If End If End Sub End If Next i iPos = iPos - 1 mFileName = Left(mFileName, iPos) '去掉了后缀的文件名称 If mSubject = "" Then mSubject = mFileName Else mSubject = mSubject & ", " & mFileName End If Next CurrentMail.Subject = mSubject '把得到的名称写入邮件主题 Else MsgBox "当前邮件没有附件" End If End If End Sub
[此贴子已经被作者于2007-1-12 10:58:26编辑过] |