|
|
本帖最后由 闻启学 于 2013-12-23 16:04 编辑
明天我帮你玩玩
完成了
- Sub SaveAttachments() '//获得发件人的地址
- Dim Application As Outlook.Application
- Dim MyNameSpace As NameSpace
- Dim myFolder As MAPIFolder
- Dim Folder As MAPIFolder
- Dim iMail As Outlook.MailItem
- Dim ExcelApp
- Set ExcelApp = GetObject(, "Excel.Application")
- Set wbk = ExcelApp.Workbooks.Open("f:/测试中.xlsx")
- Set wst = wbk.Sheets(1)
- Dim count1, count2, T As Long
- count1 = CreateObject("scripting.FileSystemObject").GetFolder(path0).Files.Count
- Set Application = New Outlook.Application
- Set MyNameSpace = Application.GetNamespace("MAPI")
- 'Set myFolder = MyNameSpace.PickFolder
- Set myFolder = MyNameSpace.GetDefaultFolder(olFolderInbox) '//获得收件箱文件夹
- For i = 1 To myFolder.Folders.Count
- Set Folder = myFolder.Folders(i)
- For Each iMail In Folder.Items
- j = j + 1
- wst.cells(j, 1) = iMail.To
- wst.cells(j, 2) = iMail.CC
- Next iMail
- Next
- wbk.Close True
-
- Set iMail = Nothing
- Set myFolder = Nothing
- Set MyNameSpace = Nothing
- Set Application = Nothing
- End Sub
|
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2013-12-21 16:54
楼主
