Lấy thông tin người dùng trên OUTLOOK bằng VBA

[tuhocvba]

Sub GetUserInfoFromExchange()
    Dim myNameSpace As NameSpace
    Dim myAddressList As addresslist
    Dim myAddressEntries As AddressEntries
    
    Set myNameSpace = Application.GetNamespace("MAPI")
    Set myAddressList = myNameSpace.AddressLists("Offline Global Address List")
    Set myAddressEntries = myAddressList.AddressEntries
      
    Dim l As AddressEntry
    Dim oExUser As ExchangeUser
    For Each l In myAddressEntries
        Set oExUser = l.GetExchangeUser
        If Not oExUser Is Nothing Then
            Debug.Print ("★☆★☆★☆★☆★☆★☆★☆★☆★☆★☆★☆★☆")
            Debug.Print ("社名：" & oExUser.CompanyName)
            Debug.Print ("部署：" & oExUser.Department)
            Debug.Print ("役職：" & oExUser.JobTitle)
            Debug.Print ("氏名：" & oExUser.Name)
            Debug.Print ("TEL：" & oExUser.BusinessTelephoneNumber)
            Debug.Print ("Mobile：" & oExUser.MobileTelephoneNumber)
            Debug.Print ("郵便番号：" & oExUser.PostalCode)
            Debug.Print ("オフィスロケーション：" & oExUser.OfficeLocation)
            Debug.Print ("Type：" & oExUser.Type)
            Debug.Print ("住所：" & oExUser.StreetAddress)
            Debug.Print ("メールアドレス：" & oExUser.PrimarySmtpAddress)
            Debug.Print ("★☆★☆★☆★☆★☆★☆★☆★☆★☆★☆★☆★☆")
            Debug.Print ("")
            Debug.Print ("")
            Debug.Print ("")
        End If
    Next
End Sub

Nguồn:

Bạn cần đăng nhập để thấy link

 

[Thvba84]

Vừa F8 cái bào lỗi dòng khai báo biến
Dim myNameSpace As NameSpace
--> sửa thế nào hả bác?