请诊断以下代码：自动保存附件

jour

Outlook2003，“规则和通知”中，
规则：带有附件
运行：脚本
功能：
当发件人邮件地址中含有"zhangsan"时，把附件保存到目录："f:\outlook\attachment\张三\"
当发件人邮件地址中含有"lisi"时，把附件保存到目录："f:\outlook\attachment\李四\"
否则，把附件保存到目录："f:\outlook\attachment\未分组\"

脚本参考：
http://blog.ipodmp.com/archives/ ... y-save-attachments/

脚本：

1. Public Sub SaveAttach(Item As Outlook.MailItem)
   
2. 
   
3.     Dim RootPath, NewF, NewPath
   
4.    
   
5. Select Case Item.SenderEmailAddress
   
6.    
   
7.     Case InStr(Item.SenderEmailAddress, "zhangsan") > 0
   
8.    
   
9.         RootPath = "f:\outlook\attachment\张三"
   
10.    
    
11.     Case InStr(Item.SenderEmailAddress, "lisi") > 0
    
12.    
    
13.         RootPath = "f:\outlook\attachment\李四"
    
14.                
    
15.     Case Else
    
16.         
    
17.         RootPath = "f:\outlook\attachment\未分组"
    
18.         
    
19.     End Select
    
20.    
    
21.    
    
22.     NewF = Date & "." & Item.Subject
    
23.     NewPath = RootPath & NewF & ""
    
24. 
    
25.     SaveAttachment Item, NewPath, "*.*"
    
26. End Sub
    
27. 
    
28.    
    
29. 
    
30. ' 保存附件函数
    
31. ' path为保存路径，condition为附件名匹配条件
    
32. Private Sub SaveAttachment(ByVal Item As Object, ByVal path As String, Optional condition = "*")
    
33.     Dim olAtt As Attachment
    
34.     Dim i As Integer
    
35.     '检查文件夹是否存在，不存在就新建
    
36.     Dim fso, f
    
37.     Set fso = CreateObject("Scripting.FileSystemObject")
    
38.     If fso.FolderExists(path) <> True Then
    
39.         fso.CreateFolder (path)
    
40.     End If
    
41.     '循环保存附件
    
42.     If Item.Attachments.Count > 0 Then
    
43.         For i = 1 To Item.Attachments.Count
    
44.             Set olAtt = Item.Attachments(i)
    
45.             If olAtt.FileName Like condition Then
    
46.                 olAtt.SaveAsFile path & olAtt.FileName
    
47.             End If
    
48.         Next
    
49.     End If
    
50.     MsgBox "此次保存 " & Item.Attachments.Count & " 个对象."
    
51.     Set olAtt = Nothing
    
52. End Sub
    
53. 
    
54. '该函数自动补充不足的"0″
    
55. Function RLeft(sval)
    
56.     RLeft = Right("00" & CStr(sval), 2)
    
57. End Function

复制代码

运行结果：
全部附件都保存到了"f:\outlook\attachment\未分组\"目录。

求高手帮忙看看哪不对，谢谢！

dsd999

不能用select case，

用if else

jour

改成if else后好了，多谢。
还有个问题：
RootPath = "f:\outlook\attachment\未分组" & year(date) & “\" &  month(date) & "\"
为什么不行？去掉其中的两个 "\" 就又行了。

[ 本帖最后由 jour 于 2011-5-10 16:30 编辑 ]

dsd999

你想存成什么样子？
举个例子

jour

就是想把未分组附件按年、月目录存放

dsd999

& Year(Date) & "\" & Month(Date) & "\"

这个我试了，没问题啊。

lesliezhang1983

dsd999 发表于 2011-5-11 09:03
& Year(Date) & "\" & Month(Date) & "\"

这个我试了，没问题啊。

那请教，完整的代码是什么呢？为什么我在office outlook2007里就执行不了？

lesliezhang1983

jour 发表于 2011-5-10 16:27
改成if else后好了，多谢。
还有个问题：
RootPath = "f:\outlook\attachment\未分组" & year(date) & “ ...

怎么改成IF ELSE？