从邮件项中获取电子邮件ID地址

Question

我有以下编码从邮件项目中获取电子邮件ID地址，但是当我通过单击按钮调用该功能时，它不起作用。请协助。

Sub Button1_Click()
Dim Path As String
Path = "C:\Users\GShaikh\Desktop\My working\Macro\New folder\Ilearn - Grp 1\"

GetEmailIds(Path + "*.msg")

end sub

Function GetEmailIds(ByVal Itm As Object) As Long
Dim ToList              As Outlook.Recipients
Dim EmilAc              As Outlook.Recipient
Dim Eml_PA              As Outlook.PropertyAccessor
Dim PrivDisMembCnt      As Integer
Dim OMItm               As Variant
Dim EmailAccAdd         As String
Dim TempLoop1           As Integer
Dim TempString          As String
Const PidTagSmtpAddress As String = "http://schemas.microsoft.com/mapi/proptag/0x39FE001E"

GetEmailIds = 0
Set OMItm = Itm
Set Glb_EmailIDList = New Collection
GET EMAIL ADDRESS DETAILS
For Each EmilAc In OMItm.Recipients
    On Error Resume Next

    If EmilAc.DisplayType = olPrivateDistList Then
       If Err.Number <> 0 Then GoTo Manualcheck:
       On Error Resume Next
       PrivDisMembCnt = EmilAc.AddressEntry.Members.Count
       On Error GoTo 0
       If PrivDisMembCnt = 0 Then
          On Error Resume Next
          Glb_EmailIDList.Add EmilAc.Address, EmilAc.Address
          On Error GoTo 0
       Else
          For TempLoop1 = 1 To PrivDisMembCnt
              Set Eml_PA = EmilAc.AddressEntry.Members(TempLoop1).PropertyAccessor
              If Eml_PA.Parent.Type = "SMTP" Then
                 EmailAccAdd = Eml_PA.Parent.Address
              Else
                 EmailAccAdd = Eml_PA.GetProperty(PidTagSmtpAddress)
               End If
               On Error Resume Next
               Glb_EmailIDList.Add EmailAccAdd, EmailAccAdd
               On Error GoTo 0
            Next TempLoop1
        End If

    Else
Manualcheck:
      Set Eml_PA = EmilAc.PropertyAccessor
      EmailAccAdd = Eml_PA.GetProperty(PidTagSmtpAddress)
      On Error Resume Next
      Glb_EmailIDList.Add EmailAccAdd, EmailAccAdd
      On Error GoTo 0
    End If
    On Error GoTo 0
Next
End If

End Function