希望你们都很好。我已经制作了一个电子邮件报告工具，我真的很挣扎。每行都有一个ID号（从第1列开始，第G列第2行）。当回复进来时，我需要回复才能拥有原始ID。使用entryid尝试但是当回复电子邮件回来时这个值会改变，所以它不是很好。
以下是我的代码;
Option Explicit
Const fPath As String = "C:\Users\neo_s_000\Desktop\Emails\" 'The path to save the messages
Const sfName As String = "C:\Users\neo_s_000\Desktop\Message Log.xlsx"
Sub Download_Outlook_Mail_To_Excel()
Dim olApp As Object
Dim olFolder As Object
Dim olNS As Object
Dim xlBook As Workbook
Dim xlSheet As Worksheet
Dim NextRow As Long
Dim i As Long
Dim olItem As Object
If FileExists(sfName) Then
Set xlBook = Workbooks.Open(sfName)
Set xlSheet = xlBook.Sheets(1)
Else
Set xlBook = Workbooks.Add
Set xlSheet = xlBook.Sheets(1)
With xlSheet
.Cells(1, 1) = "Sender"
.Cells(1, 2) = "Subject"
.Cells(1, 3) = "Date"
'.Cells(1, 4) = "Size"
.Cells(1, 5) = "EmailID"
.Cells(1, 6) = "Body"
.Cells(1, 7) = "ID"
End With
xlBook.SaveAs sfName
End If
On Error Resume Next
Set olApp = GetObject(, "Outlook.Application")
If Err <> 0 Then
Set olApp = CreateObject("Outlook.Application")
End If
On Error GoTo 0
With xlSheet
.Cells(1, 1) = "Sender"
.Cells(1, 2) = "Subject"
.Cells(1, 3) = "Date"
'.Cells(1, 4) = "Size"
.Cells(1, 5) = "EmailID"
.Cells(1, 6) = "Body"
.Cells(1, 7) = "ID"
CreateFolders fPath
Set olNS = olApp.GetNamespace("MAPI")
olNS.Logon
Set olFolder = olNS.PickFolder
For Each olItem In olFolder.Items
NextRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
If olItem.Class = 43 Then
.Cells(NextRow, 1) = olItem.Sender
.Cells(NextRow, 2) = olItem.Subject
.Cells(NextRow, 3) = olItem.SentOn
'.Cells(NextRow, 4) =
.Cells(NextRow, 5) = SaveMessage(olItem)
.Cells(NextRow, 6) = olItem.Body
End If
Next olItem
MsgBox "Outlook Mails Extracted to Excel"
End With
xlBook.Close SaveChanges:=True
lbl_Exit:
Set olApp = Nothing
Set olFolder = Nothing
Set olItem = Nothing
Set xlBook = Nothing
Set xlSheet = Nothing
Exit Sub
End Sub
Function SaveMessage(olItem As Object) As String
Dim Fname As String
Fname = Format(olItem.ReceivedTime, "yyyymmdd") & Chr(32) & _
Format(olItem.ReceivedTime, "HH.MM") & Chr(32) & olItem.sendername & " - " & olItem.Subject
Fname = Replace(Fname, Chr(58) & Chr(41), "")
Fname = Replace(Fname, Chr(58) & Chr(40), "")
Fname = Replace(Fname, Chr(34), "-")
Fname = Replace(Fname, Chr(42), "-")
Fname = Replace(Fname, Chr(47), "-")
Fname = Replace(Fname, Chr(58), "-")
Fname = Replace(Fname, Chr(60), "-")
Fname = Replace(Fname, Chr(62), "-")
Fname = Replace(Fname, Chr(63), "-")
Fname = Replace(Fname, Chr(124), "-")
SaveMessage = SaveUnique(olItem, fPath, Fname)
lbl_Exit:
Exit Function
End Function
Private Function SaveUnique(oItem As Object, _
strPath As String, _
strFileName As String) As String
Dim lngF As Long
Dim lngName As Long
lngF = 1
lngName = Len(strFileName)
Do While FileExists(strPath & strFileName & ".msg") = True
strFileName = Left(strFileName, lngName) & "(" & lngF & ")"
lngF = lngF + 1
Loop
oItem.SaveAs strPath & strFileName & ".msg"
SaveUnique = strPath & strFileName & ".msg"
lbl_Exit:
Exit Function
End Function
Private Sub CreateFolders(strPath As String)
Dim strTempPath As String
Dim iPath As Long
Dim vPath As Variant
vPath = Split(strPath, "\")
strPath = vPath(0) & "\"
For iPath = 1 To UBound(vPath)
strPath = strPath & vPath(iPath) & "\"
If Not FolderExists(strPath) Then MkDir strPath
Next iPath
End Sub
Private Function FolderExists(ByVal PathName As String) As Boolean
Dim nAttr As Long
On Error GoTo NoFolder
nAttr = GetAttr(PathName)
If (nAttr And vbDirectory) = vbDirectory Then
FolderExists = True
End If
NoFolder:
End Function
Private Function FileExists(filespec) As Boolean
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists(filespec) Then
FileExists = True
Else
FileExists = False
End If
lbl_Exit:
Exit Function
End Function
有什么想法吗？
答案 0 :(得分：1)
好的，很抱歉花了这么长时间才得到答案。我会试着告诉你我在评论中说的话。
早期与晚期绑定
在OOP中，我们互动的所有对象都有Type (aka Class)
我们通过访问与其关联的成员来使用这些对象，这些成员由其类型定义。
为了访问这些成员，运行时环境需要知道类型是什么。
在执行代码之前，我们可以告诉运行时环境类型是什么（所以在编译时），这称为Early Binding。或者，我们可以让RTE在执行时（因此在运行时）将其计算出来，这称为Late Binding。
在编译时定义类型是通过将对象声明为预期类型来完成的。例如：
Dim xlApp as Excel.Application
在运行时定义它是通过将对象声明为基类型然后将其转换为继承基类型的另一种类型来完成的。最常用的是Object的基本类型，因为所有类型都是从Object类型派生的。 （或Variant常见于VBA，因为它可以表示任何数据类型）。 E.g：
Dim xlApp as Object
使用早期绑定对您（程序员）的主要优势是Intellisense，但使用早期绑定有许多优点，例如程序优化，调试，错误捕获等。
您可以阅读有关这些概念的更多信息here，但这就是它的主旨。
类型库
为了将对象声明为我们想要的类型，我们需要确保IDE可以使用该类型。类型包含在库中（通常是.DLL文件），我们可以添加对这些库的引用以使用它们中定义的类型。在VBA中，我们通过“添加引用”来执行此操作，该引用可从Tools菜单中获得。
所有这些都在我昨天链接的reference中解释。
实施早期绑定：
要使用早期绑定，请按照上面的链接中的描述设置引用，然后将变量声明更改为从Outlook命名空间中调出适当的类型，如下所示：
Dim olApp As Outlook.Application
Dim olFolder As Outlook.Folder
Dim olNS As Outlook.Namespace
Dim xlBook As Workbook 'This is the same as Excel.Workbook... Excel is the default namespace and a reference is automatically included in your VBA project when you enter VBA from Excel (e.g. using AL+F11 or macro-recorder)
Dim xlSheet As Worksheet 'Same as Excel.Worksheet...
Dim NextRow As Long
Dim i As Long
Dim olItem As Object 'Here we have to use late binding because the return from Folder.Items collection can contain objects of multiple types (e.g. MailItem, MeetingItem, AppointmentItem, etc.)
实施ID字段：
就填充ID字段而言，您可以使用Conversation.ConversationID属性获得所需内容。
E.g。
For Each olItem In olFolder.Items
NextRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
If olItem.Class = 43 Then
.Cells(NextRow, 1) = olItem.Sender
.Cells(NextRow, 2) = olItem.Subject
.Cells(NextRow, 3) = olItem.SentOn
'.Cells(NextRow, 4) =
.Cells(NextRow, 5) = SaveMessage(olItem)
.Cells(NextRow, 6) = olItem.Body
Dim Convo as Outlook.Conversation
Set Convo = olItem.GetConversation()
.Cells(NextRow, 7) = convo.conversationID
End If
Next olItem