能否用VBA实现调用excel表格里面的一些数据对特定邮箱search邮件

dsd999

周五之前尽量帮你写出来。

lijunnju

真是太感谢了
可否帮忙星期四,星期五就要用....
真的不好意思,麻烦了

dsd999

Sub FindMail()

    Dim xlApp As Object
   
    Dim objFolder As Object
   
    On Error Resume Next
   
    Set xlApp = CreateObject("Excel.Application")
    If xlApp Is Nothing Then Exit Sub
   
    Dim FileName As Variant
   
    FileName = xlApp.GetOpenFilename("Excel 文件 (*.xls),*.xls")
    If FileName = False Then Exit Sub
   
    Dim wb As Excel.Workbook
    Dim ws As Excel.worksheet
   
    Set wb = Workbooks.Open(FileName)
    Set ws = wb.Sheets("Sheet1")
   
    Dim rowCount As Long
    rowCount = ws.[A65536].End(xlUp).Row
    If rowCount = 0 Then
        MsgBox "Excel文件没有数据"
        Exit Sub
    End If
   
    Dim objSourceFolder As Outlook.MAPIFolder
   
    Set objSourceFolder = GetNamespace("MAPI").PickFolder
   
    Dim appItem As Outlook.mailItem
    Dim objOutlook As New Outlook.Application
    Set mobjOutlook = objOutlook.GetNamespace("MAPI")
    Set objFolder = mobjOutlook.GetDefaultFolder(olFolderInbox)
    For Each objItem In objFolder.Items
    If objItem.Class = olMail Then
      Set appItem = objItem
        For i = 1 To rowCount
            If (InStr(1, appItem.Subject, ws.Cells(i, 1)) <> 0) Then
            appItem.Move objSourceFolder
            Exit For
            End If
        Next
    End If
    Next
   
   
    xlApp.Quit
    Set xlApp = Nothing
   
    MsgBox "完成"

End Sub

lijunnju

谢谢啦,撒花

lijunnju

请问sheet1应该放在哪里?

dsd999

原帖由 lijunnju 于 2011-1-27 10:53 发表
请问sheet1应该放在哪里?

不明白你的问题？

lijunnju

dsd999

添加reference，如图

lijunnju

perfect
谢谢
另外再请教一下,如果我的search folder不是inbox, 而是其他folder的话应该改哪一行代码?

dsd999

原帖由 lijunnju 于 2011-1-27 13:02 发表
perfect
谢谢
另外再请教一下,如果我的search folder不是inbox, 而是其他folder的话应该改哪一行代码?

是自己创建的folder吗？