outlook exchange server有大小限制，我想用一个VBA实现规则的功能。

safty_xu

利用outlook2003 vba 移动收到的邮件或会议通知到不同的指定文件夹
内，具体功能要求如下：在硬盘某分区建立一个Excel表 文件，第一列表头“发件人邮件地址”；第二列表头“发件人姓名”；第三列“文件夹名称”
当收到邮件、会议通知时触发VBA程序，如果发件人包含先前设置好的excel表内第一列或第二列某单元给的值，则将邮件自动移动到以该单元格右边单元格的值为名的outlook文件夹内。 请高手帮忙！

safty_xu

最好用EXCEL记录实现。
如果EXCEL结合实现不了，我想借用ACCESS+ADODB+SQL实现。但是以下代码中估计问题出在SQL语句，请帮忙指点。SQL语句可能无法应用senderemailaddress 及sendername,请高手指点！

Private WithEvents Items As Outlook.Items
Private Sub Application_Startup()
    Dim olApp As Outlook.Application
    Dim objNS As Outlook.NameSpace
    Set olApp = Outlook.Application
    Set objNS = olApp.GetNamespace("MAPI")
     
     
     ' (1) default Inbox
    Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub Items_ItemAdd(ByVal item As Object)
    On Error GoTo ErrorHandler
     ' (2) only act if it's a MailItem
    Dim Msg As Outlook.MailItem
    Dim fldr As Outlook.MAPIFolder
   
        Dim cnn As New ADODB.Connection
        Dim rs As New ADODB.Recordset
        Dim mydata As String
        Dim SQL As String
        Dim s As String
    If TypeName(item) = "MailItem" Then
        Set Msg = item
            x = Msg.SenderEmailAddress
        mydata = "D:\outlook规则.mdb"
        Set cnn = New ADODB.Connection  '建立与数据库的连接
        With cnn
            .Provider = "microsoft.jet.oledb.4.0"
            .Open mydata
        End With
            SQL = "select * from  rule   where 邮箱 LIKE '%" & Msg.SenderEmailAddress & "%' or 姓名 LIKE '%" & Msg.SenderName & "%'"
            rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic
            If rs.RecordCount <> 0 Then
               rs.movefirst
               Set fldr = Outlook.Session.GetDefaultFolder(olFolderInbox).Folders(rs.Fields("归类文件夹"))
               Msg.Move fldr
            rs.Close
            Set rs = Nothing
            Set cnn = Nothing
            End If
    End If
ProgramExit:
    Exit Sub
ErrorHandler:
    MsgBox Err.Number & " - " & Err.Description
    Resume ProgramExit
End Sub

dsd999

SQL语句可能无法应用senderemailaddress 及sendername，这个没看明白？

你运行这段代码具体的错误时什么？有个截图更好。

safty_xu

版主您好：
“SQL语句可能无法应用senderemailaddress 及sendername”我的意思是senderemailaddress 及sendername是否不能被写在SQL的Select语句中。
运行我的代码出现的错误时“13-类型不匹配”，截图如附件。

dsd999

看了你的代码
Set fldr = Outlook.Session.GetDefaultFolder(olFolderInbox).Folders(rs.Fields("归类文件夹"))
这句有问题。

Function Item(Index) As MAPIFolder
    Member of Outlook.Folders

Folders里应该是index，不是名字。

safty_xu

请问版主那我的代码如何改？

safty_xu

我不用ACCESS数据库，单独在代码设定一个条件，以下代码是可以运行的（Folders里的是名字。）
Private WithEvents Items As Outlook.Items
Private Sub Application_Startup()
    Dim olApp As Outlook.Application
    Dim objNS As Outlook.NameSpace
    Set olApp = Outlook.Application
    Set objNS = olApp.GetNamespace("MAPI")
     ' (1) default Inbox
    Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub Items_ItemAdd(ByVal item As Object)
    On Error GoTo ErrorHandler   
     ' (2) only act if it's a MailItem
    Dim Msg As Outlook.MailItem
    Dim fldr As Outlook.MAPIFolder   
    If TypeName(item) = "MailItem" Then
        Set Msg = item         
        If Msg.SenderEmailAddress = "derek_hsu@163.com" Then ' edit this part
            Set fldr = Outlook.Session.GetDefaultFolder(olFolderInbox).Folders("Self")
            Msg.Move fldr
        End If      
    End If
ProgramExit:
    Exit Sub
ErrorHandler:
    MsgBox Err.Number & " - " & Err.Description
    Resume ProgramExit
End Sub

dsd999

Set fldr = Outlook.Session.GetDefaultFolder(olFolderInbox).Folders(rs.Fields("归类文件夹"))

改成
s = rs.Fields("归类文件夹")
Set fldr = Outlook.Session.GetDefaultFolder(olFolderInbox).Folders(s)
就可以了。

safty_xu

版主果然是版主。谢谢！成功运行代码！

safty_xu

版主您好：
如果我的代码：
SQL = "select * from  rule   where 邮箱 LIKE '%" & Msg.SenderEmailAddress & "%' or 姓名 LIKE '%" & Msg.SenderName & "%'"
要实现（查找语句）where 邮箱 记录的字符串包含在Msg.SenderEmailAddress 的字符串内的代码如何实现？
我的现有代码是查找记录字段包好Msg.SenderEmailAddress 字符串的记录。两者正好相反！