我的目标是每当我收到特定主题的邮件时更新excel表(我设置了将相关邮件移动到文件夹的规则).
我在这个网站上看到过类似的帖子,但是给出的代码并不完整.不是'专业'或'技术'是非常难以编码的.
邮件包含:
文件名:所有者名称:上次更新日期:文件位置(这将是共享驱动器路径):
我每天都会收到这封邮件,需要在excel表中更新这些信息.(我会一直开到月末)
请帮我.提前致谢
Ton*_*ore 33
Introduction
In the first version of this answer, I referred you to another question which I now know you will not be able to read.
All the code you need is here but this is not written as an immediate solution. This is a tutorial which introduces you to the Outlook object model, getting data out of the outlook database and into an Excel workbook. Don't worry that you are not "a 'pro' or 'techie'"; once we were all newbies. Work through the sections. Don't worry if you don't understand it all. Just pick out the bits you need now. When you want to enhance your solution, come back to this tutorial and the code which you will have copied to your disc.
在以下部分中,AnswerA()和AnswerB()旨在帮助您了解文件夹结构.AnswerC1()也是一种短期培训援助.但是,AnswerC2()和AnswerC3()是您可能需要的子程序.如果你保留它们,我建议你重命名; 例如:FindFolder()和FindFolderSub().
AnswerD() is also a training aid but one you should retain. This shows you how to access a few mail item properties but I you may need access to more mail item properties than I have shown. Within the VB Editor, click F2 to display the Object Explorer. Scroll down the list of classes to MailItem. You will be shown a list of over 100 methods and properties. Some are obvious but you will have to use VB Help to discover the purpose of many. Expand AnswerD() to use methods or display properties you think might be useful.
AnswerE() is a development aid but also provides the structure for your macro. Currently it outputs to disc the text and html bodies of the mail items within a folder. You do not want to do this at the moment but you might. I archive all my emails to Excel. I create one row per email with columns for sender, recipients, subject, dates, etc. I save the text body, html body and any attachments to disc and create hyperlinks to them. I have emails going back years from multiple Outlook installations.
AnswerF1() shows you how to create a new Excel workbook and AnswerF2() shows you how to open an existing Excel workbook. I assume AnswerF2() is what you need.
There is a lot here but if you work through it steadily you will come to understand the Outlook object model and how to achieve your objective.
Health warning
Everything in this answer was discovered by experimentation. I started with VB Help, used F2 to access the object model and experimented until I found what worked. I did buy a highly recommended reference book but it contained nothing important I had not discovered and omitted much that I had discovered.
I suspect that a key feature of the knowledge I have gained is that it is based on many different installations. Some of the problems encountered may have been the result of installation mistakes which would explain why reference book authors did not know of them.
The code below has been tested with Excel 2003 and Outlook Exchange 2003 and 2007.
Getting started if you are unfamiliar with Outlook VBA
Open "Outlook" or "Outlook Exchange". These macros do not work with "Outlook Express".
从工具栏中,选择"工具","宏","安全".如果安全级别尚未达到该级别,请将其更改为"中".这意味着只能在您明确批准的情况下运行宏.
要启动Outlook VB编辑器:
1)从工具栏中,选择工具,宏,宏或单击Alt + F11 2)选择启用宏.
从工具栏中,选择"插入","模块".
您可以看到一个,两个或三个窗口.左下方应该是Project Explorer.您今天不需要它,但如果缺少它,请单击Ctrl + R以显示它.在右侧,在顶部,是您将代码放入的区域.在底部,您应该看到立即窗口.如果缺少立即窗口,请单击Ctrl + G以显示它.下面的宏都使用立即窗口输出,所以你必须能够看到它.
The cursor will be in the code area.
Enter: Option Explicit.
This instructs the VB Editor to check that all variables are defined. The code below have been tested but this avoids one type of error in any code you may enter.
One by one, copy and paste the macros below into the code area.
Macros AnswerC(), AnswerD(), Answer(E), AnswerF1() and AnswerF2() will require some modification before running. Instructions within the macro.
To run a macro, place the cursor within it and press F5.
Accessing the top two folder levels
The top level of folders are of type Folders. All subfolders are of type MAPIFolder. I have never tried accessing the top level other than as a means of getting to the subfolders.
AnswerA() gets access to the Outlook Exchange database and outputs the names of the top level folders to the Immediate Window.
Sub AnswerA()
Dim InxIFLCrnt As Integer
Dim TopLvlFolderList As Folders
Set TopLvlFolderList = _
CreateObject("Outlook.Application").GetNamespace("MAPI").Folders
For InxIFLCrnt = 1 To TopLvlFolderList.Count
Debug.Print TopLvlFolderList(InxIFLCrnt).Name
Next
End Sub
AnswerB() outputs the names of the top level folders and their immediate children.
Sub AnswerB()
Dim InxIFLCrnt As Integer
Dim InxISLCrnt As Integer
Dim SndLvlFolderList As MAPIFolder
Dim TopLvlFolderList As Folders
Set TopLvlFolderList = _
CreateObject("Outlook.Application").GetNamespace("MAPI").Folders
For InxIFLCrnt = 1 To TopLvlFolderList.Count
Debug.Print TopLvlFolderList(InxIFLCrnt).Name
Set SndLvlFolderList = TopLvlFolderList.Item(InxIFLCrnt)
For InxISLCrnt = 1 To SndLvlFolderList.Folders.Count
Debug.Print " " & SndLvlFolderList.Folders(InxISLCrnt).Name
Next
Next
End Sub
The problem with AnswerB() is that the children can have children can have children to any depth. You need to be able to find a particular folder whatever the depth.
Find named folder
If you want to search a default folder such as "Inbox" or "Sent Items" you will not need this code. If you copy the messages containing tables to a different folder you will need this code. Even if you decide you do not need this code now, I suggest you keep it in case you need it in the future.
The code below uses two sub-routines. The caller assembles a folder name such as "Personal Folders|MailBox|Inbox". The sub-routines work down the hierarchy and return the required folder as an object if it is found.
Note: the special case of locating a default folder such as "Inbox" or "Sent Items" is discussed later.
Sub AnswerC1()
' This routine wants a folder. It does nothing but display its name.
Dim FolderNameTgt As String
Dim FolderTgt As MAPIFolder
' The names of each folder down to the one required separated
' by a character not used in folder names.
' ##############################################################
' Replace "Personal Folders|MailBox|Inbox" with the name
' of one of your folders. If you use "|" in your folder names,
' pick a different separator and change the call of AnswerC2().
' ##############################################################
FolderNameTgt = "Personal Folders|MailBox|Inbox"
Call AnswerC2(FolderTgt, FolderNameTgt, "|")
If FolderTgt Is Nothing Then
Debug.Print FolderNameTgt & " not found"
Else
Debug.Print FolderNameTgt & " found: " & FolderTgt.Name
End If
End Sub
Sub AnswerC2(ByRef FolderTgt As MAPIFolder, NameTgt As String, NameSep As String)
' This routine initialises the search and finds the top level folder
Dim InxFolderCrnt As Integer
Dim NameChild As String
Dim NameCrnt As String
Dim Pos As Integer
Dim TopLvlFolderList As Folders
Set FolderTgt = Nothing ' Target folder not found
Set TopLvlFolderList = _
CreateObject("Outlook.Application").GetNamespace("MAPI").Folders
' Split NameTgt into the name of folder at current level
' and the name of its children
Pos = InStr(NameTgt, NameSep)
If Pos = 0 Then
' I need at least a level 2 name
Exit Sub
End If
NameCrnt = Mid(NameTgt, 1, Pos - 1)
NameChild = Mid(NameTgt, Pos + 1)
' Look for current name. Drop through and return nothing if name not found.
For InxFolderCrnt = 1 To TopLvlFolderList.Count
If NameCrnt = TopLvlFolderList(InxFolderCrnt).Name Then
' Have found current name. Call AnswerC3() to look for its children
Call AnswerC3(TopLvlFolderList.Item(InxFolderCrnt), _
FolderTgt, NameChild, NameSep)
Exit For
End If
Next
End Sub
Sub AnswerC3(FolderCrnt As MAPIFolder, ByRef FolderTgt As MAPIFolder, _
NameTgt As String, NameSep As String)
' This routine finds all folders below the top level
Dim InxFolderCrnt As Integer
Dim NameChild As String
Dim NameCrnt As String
Dim Pos As Integer
' Split NameTgt into the name of folder at current level
' and the name of its children
Pos = InStr(NameTgt, NameSep)
If Pos = 0 Then
NameCrnt = NameTgt
NameChild = ""
Else
NameCrnt = Mid(NameTgt, 1, Pos - 1)
NameChild = Mid(NameTgt, Pos + 1)
End If
' Look for current name. Drop through and return nothing if name not found.
For InxFolderCrnt = 1 To FolderCrnt.Folders.Count
If NameCrnt = FolderCrnt.Folders(InxFolderCrnt).Name Then
' Have found current name.
If NameChild = "" Then
' Have found target folder
Set FolderTgt = FolderCrnt.Folders(InxFolderCrnt)
Else
'Recurse to look for children
Call AnswerC3(FolderCrnt.Folders(InxFolderCrnt), _
FolderTgt, NameChild, NameSep)
End If
Exit For
End If
Next
End Sub
Examining a target folder
AnswerC2() and AnswerC3() provides the code to find a target folder. Folders contain items: mail items, meeting requests, contacts, calendar entries and more. Only mail items are examined by this code. Accessing meeting requests is essentially the same but they have different properties.
AnswerD() outputs a selection of a mail item's properties.
Once you have tried AnswerD() on a selection of folders, press F2 or, from the tool bar, select View, Object Browser. Scroll down the list of items until you reach MailItem. The members' area will display all its properties and methods of which there are in excess of 100. Some are pretty obvious; most you will have to look up in VB Help. Amend this routine to explore more properties and methods and, perhaps, other types of item.
Warning. This code is designed to look through a named folder for mail items. You may encounter problems if you amend the code to explore the entire folder hierarchy. It could have been my mistake or it could have been faults in the installation but I have found that my code crashes if I attempt to access certain folders such as "RSS Feeds". I have never been interested enough to explore these crashes and have simply amended my tree search to ignore branches with selected names.
When you run this macro, you will receive a warning: "A program is trying to access e-mail addresses you have stored in Outlook. Do you want to allow this?" Tick "Allow access for", select an interval, and click Yes.
Sub AnswerD()
Dim FolderItem As Object
Dim FolderItemClass As Integer
Dim FolderNameTgt As String
Dim FolderTgt As MAPIFolder
Dim InxAttach As Integer
Dim InxItemCrnt As Integer
' ##############################################################
' Replace "Personal Folders|MailBox|Inbox" with the name
' of one of your folders. If you use "|" in your folder names,
' pick a different separator and change the call of AnswerC2().
' ##############################################################
FolderNameTgt = "Personal Folders|MailBox|Inbox"
Call AnswerC2(FolderTgt, FolderNameTgt, "|")
If FolderTgt Is Nothing Then
Debug.Print FolderNameTgt & " not found"
Else
' Display mail items, if any, within folder
Debug.Print "Mail items within " & FolderNameTgt
For InxItemCrnt = 1 To FolderTgt.Items.Count
Set FolderItem = FolderTgt.Items.Item(InxItemCrnt)
With FolderItem
' This code seems to avoid syncronisation errors
FolderItemClass = 0
On Error Resume Next
FolderItemClass = .Class
On Error GoTo 0
If FolderItemClass = olMail Then
' Display Received date, Attachment count and Subject
Debug.Print " Mail item: " & InxItemCrnt
Debug.Print " Received=" & Format(.ReceivedTime, _
"ddmmmyy hh:mm:ss") & " " & _
.Attachments.Count & _
" attachments Subject = " & .Subject
Debug.Print " Sender: " & .SenderName
With .Attachments
' If the are attachments display their types and names
If .Count > 0 Then
Debug.Print " Attachments:"
For InxAttach = 1 To .Count
With .Item(InxAttach)
Debug.Print " Type=";
Select Case .Type
Case olByReference
Debug.Print "ByRef";
Case olByValue
Debug.Print "ByVal";
Case olEmbeddeditem
Debug.Print "Embed";
Case olOLE
Debug.Print " OLE";
End Select
Debug.Print " DisplayName=" & .DisplayName
End With
Next
End If
End With
End If
End With
Next InxItemCrnt
End If
End Sub
Saving bodies to disc
AnswerE() finds a folder of your choice and saves a copy of the text and html bodies of every mail item within it. I suggest you copy a select of messages containing table to a new folder and run AnswerE(). This is not directly relevant to your questions but I believe it will aid understanding.
When you run this macro, you will receive a warning: "A program is trying to access e-mail addresses you have stored in Outlook. Do you want to allow this?" Tick "Allow access for", select an interval, and click Yes.
Sub AnswerE()
' Output any Text or HTML bodies found within specified folder
Dim FolderItem As Object
Dim FolderItemClass As Integer
Dim FolderNameTgt As String
Dim FolderTgt As MAPIFolder
Dim FileSystem As Object
Dim FileSystemFile As Object
Dim HTMLBody As String
Dim InxAttach As Integer
Dim InxItemCrnt As Integer
Dim PathName As String
Dim TextBody As String
' ##############################################################
' Replace "Personal Folders|MailBox|Inbox" with the name
' of one of your folders. If you use "|" in your folder names,
' pick a different separator and change the call of AnswerC2().
' The folder you pick must have at least one mail item with an
' HTML body for this macro to do anything.
' ##############################################################
FolderNameTgt = "Personal Folders|MailBox|Inbox"
Call AnswerC2(FolderTgt, FolderNameTgt, "|")
If FolderTgt Is Nothing Then
Debug.Print FolderNameTgt & " not found"
Exit Sub
End If
' ####################################################################
' The following is an alternative method of accessing a default folder
' such as Inbox. This statement would replace the code above.
' Set FolderTgt = CreateObject("Outlook.Application"). _
' GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
' ####################################################################
' Extract bodies if found
Set FileSystem = CreateObject("Scripting.FileSystemObject")
' ##############################################################
' Replace "C:\Email\" with the name of one of your folders
' ##############################################################
PathName = "C:\Email\"
For InxItemCrnt = 1 To FolderTgt.Items.Count
Set FolderItem = FolderTgt.Items.Item(InxItemCrnt)
With FolderItem
' This code seems to avoid syncronisation errors
FolderItemClass = 0
On Error Resume Next
FolderItemClass = .Class
On Error GoTo 0
If FolderItemClass = olMail Then
HTMLBody = Trim(.HTMLBody)
If HTMLBody <> "" Then
' Save HTML body to disc. The file name is of the form
' BodyNNN.html where NNN is a a sequence number.
' First True in CreateTextFile => overwrite existing file.
' Second True => Unicode format
Set FileSystemFile = FileSystem.CreateTextFile(PathName & _
"Body" & Right("00" & InxItemCrnt, 3) & _
".html", True, True)
FileSystemFile.Write HTMLBody
FileSystemFile.Close
End If
TextBody = Trim(.Body)
If HTMLBody <> "" Then
' Save text body to disc. The file name is of the form
' BodyNNN.txt where NNN is a a sequence number.
Set FileSystemFile = FileSystem.CreateTextFile(PathName & _
"Body" & Right("00" & InxItemCrnt, 3) & _
".txt", True, True)
FileSystemFile.Write TextBody
FileSystemFile.Close
End If
End If
End With
Next InxItemCrnt
End Sub
Creating or updating an Excel workbook
You do not say if you will create a new Excel workbook or update an existing one. AnswerF1() creates a workbook. AnswerF2() opens an existing workbook.
Before trying either of these macros you must:
.
Sub AnswerF1()
Dim xlApp As Excel.Application
Dim ExcelWkBk As Excel.Workbook
Dim FileName As String
Dim PathName As String
' ##############################################################
' Replace "C:\Email\" with the name of one of your folders
' Replace "MyWorkbook.xls" with the your name for the workbook
' ##############################################################
PathName = "C:\Email\"
FileName = "MyWorkbook.xls"
Set xlApp = Application.CreateObject("Excel.Application")
With xlApp
.Visible = True ' This slows your macro but helps during debugging
Set ExcelWkBk = xlApp.Workbooks.Add
With ExcelWkBk
' Add Excel VBA code to update workbook here
.SaveAs FileName:=PathName & FileName
.Close
End With
.Quit
End With
End Sub
Sub AnswerF2()
Dim xlApp As Excel.Application
Dim ExcelWkBk As Excel.Workbook
Dim FileName As String
Dim PathName As String
' ##############################################################
' Replace "C:\Email\" with the name of one of your folders
' Replace "MyWorkbook.xls" with the your name for the workbook
' ##############################################################
PathName = "C:\Email\"
FileName = "MyWorkbook.xls"
Set xlApp = Application.CreateObject("Excel.Application")
With xlApp
.Visible = True ' This slows your macro but helps during debugging
Set ExcelWkBk = xlApp.Workbooks.Open(PathName & FileName)
With ExcelWkBk
' Add Excel VBA code to update workbook here
.Save
.Close
End With
End With
End Sub
Writing to the Excel workbook
This code finds the next free row in you workbook and writes to it. I explain why constants are useful and warn you about keeping your Outlook and Excel code apart.
' Constants allow you alter the sequence of columns in your workbook without
' having to change your code. Replace the 1, 2 and 3 in these statements
' and the job is done.
' !!! Constants must be above any subroutines and functions.
Public Const ColFrom As Integer = 1
Public Const ColSubject As Integer = 2
Public Const ColSentDate As Integer = 3
Sub AnswerG()
Dim RowNext As Integer
' This code goes at the top of your macro
With Sheets("Sheet1") ' Replace with the name of your worksheet
' This finds the bottom row with a value in column A. It then adds 1 to get
' the number of the first unused row.
RowNext = .Cells(Rows.Count, "A").End(xlUp).Row + 1
End With
' You will have to separate your Outlook and Excel code.
' With Outlook
' Var1 = .Body
' Var2 = .ReceivedTime
' Var3 = .SenderName
' End With
' With Excel
' .Cell(R, C).Value = Var1
' End With
With Sheets("Sheet1") ' Replace with the name of your worksheet
.Cells(RowNext, ColFrom).Value = "John Smith"
.Cells(RowNext, ColSubject).Value = "Our meeting"
With .Cells(RowNext, ColSentDate)
.Value = Now()
' This format means the time is stored and I can access it but it
'is not displayed. Change to "mm/dd/yy" or whatever you like.
.NumberFormat = "d mmm yy"
End With
RowNext = RowNext + 1 ' Ready for next loop
End With
End Sub
Summary
I hope I have provided an appropriate level of detail. Please respond with a comment either way.
Don't leap to the final macros. If anything goes wrong you will not understand the cause. Take the time to play with each of the earlier answers. Amend them to do something slightly different.
Best of luck. You will be amazed how quickly you will become comfortable with Outlook and VBA.