给Outlook中带附件的邮件自动加上标题

俯视姚明

不错的代码!

秦源侠士

学习了，。，。。。。。。

elmac2012

就等这个啊

elmac2012

楼主能不能整理一下，我是菜鸟，我想弄个vba直接以附件名称为邮件主题，麻烦整理一下好么，拜谢啊

ugvf2009

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  没有if字符块

闻启学

ugvf2009 发表于 2014-6-20 14:05
Sub olAddAttachedFileTitle()
Dim mFileName, mSubject As String
Dim iPos As Integer

试一试   吧

1. Sub olAddAttachedFileTitle()
   
2.     Dim mFileName, mSubject As String
   
3.     Dim iPos As Integer
   
4.     Dim i As Integer
   
5.     Set CurrentMail = ActiveInspector.CurrentItem
   
6.     If TypeName(CurrentMail) <> "MailItem" Then
   
7.         MsgBox "当前活动窗口不是一封邮件"
   
8.     Else
   
9.         If CurrentMail.Attachments.Count > 0 Then    '必须是在有附件的情况下
   
10.             For Each Item In CurrentMail.Attachments
    
11.                 mFileName = Item.Filename
    
12.                 '取得附件文件名称（包括后缀）
    
13.                
    
14.         
    
15.                
    
16. '                mLen = Len(mFileName)    '取得名称长度
    
17. '                For i = mLen To 1 Step -1
    
18. '                    If Mid(mFileName, i, 1) = "." Then iPos = i    '.的位置
    
19. '
    
20. '                Next i
    
21. '                iPos = iPos - 1
    
22.                 mFileName = Mid(mFileName, InStr(mFileName, "."), 99)     '去掉了后缀的文件名称
    
23.                 If mSubject = "" Then
    
24.                     mSubject = mFileName
    
25.                 Else
    
26.                     mSubject = mSubject & ", " & mFileName
    
27.                 End If
    
28.             Next
    
29. 
    
30. 
    
31.             CurrentMail.Subject = mSubject
    
32.             '            把得到的名称写入邮件主题
    
33.         Else
    
34.             MsgBox "当前邮件没有附件"
    
35. 
    
36.         End If
    
37.     End If
    
38. 
    
39. 
    
40. End Sub
    

复制代码

甜在昕妃16

刚入门看不懂啊，我也要好好学习

光淑

aaaaabbbbb 发表于 2008-12-6 22:33
我测试了一下是可以的，插入模块，将以下代码拷贝进去，然后新建邮件，不带附件，运行一下代码。

Sub ol ...

真棒，感谢。

johnwalk

看不懂  先做个记号 以后学习

硅谷少年

gz_wu 发表于 2010-6-26 09:56
请问这个代码利用“.”来判断后缀文件名，能不能采取从后向前的方式来找“.” ？
假如这个附档的文件名为 ...

用InStrRev()函数可以。
str = Mid(newAttachment.DisplayName, 1, InStrRev(newAttachment.DisplayName, ".") - 1)