Question : Excel Macro when run needs to check colum "L" for the NTlogin and get the machinename and ip address from the exchange server.Where the user is using them.

Hi,

Excel Macro when run needs to check colum "L" for the NTlogin and get the machinename and ip address from the exchange server.Where the user is using them.

Code from Rob needs to be changed to query from an excel and place results in colum "CP" & "CQ"
If possible need to get the Outlook Version also to colum "CR"
Regards
Sharath

Code Snippet:

         
           
             1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:

           
           
             Sub GetMailboxAccessInfo()
    Const cWMINameSpace = "root/MicrosoftExchangeV2"
    Const cWMIInstance = "Exchange_Logon"
    cComputerName = "inex"  ' Exchange Server NETBIOS Name
    
    Dim strWinMgmts   ' Connection string for WMI
    Dim objWMIExchange  ' Exchange Namespace WMI object
    Dim listExchange_Logons ' ExchangeLogons collection
    Dim objExchange_Logon   ' A single ExchangeLogon WMI object
    
    ' Create the object string, indicating WMI (winmgmts), using the
    ' current user credentials (impersonationLevel=impersonate),
    ' on the computer specified in the constant cComputerName, and
    ' using the CIM namespace for the Exchange provider.
    strWinMgmts = "winmgmts:{impersonationLevel=impersonate}!//" & cComputerName & "/" & cWMINameSpace
    On Error Resume Next
    Set objWMIExchange = GetObject(strWinMgmts)
    ' Verify we were able to correctly set the object.
    If Err.Number <> 0 Then
        Err.Clear
        On Error GoTo 0
        MsgBox "ERROR: Unable to connect to the WMI namespace."
    Else
        ' The Resources that currently exist appear as a list of
        ' Exchange_Logon instances in the Exchange namespace.
        Set listExchange_Logons = objWMIExchange.InstancesOf(cWMIInstance)
        ' Were any Exchange_Logon Instances returned?
        If (listExchange_Logons.Count > 0) Then
            ' Set CSV Headers
            'strResults = """Client IP"",""Client Name"",""Logged On User"",""Mailbox Display Name"""
            Cells(1, "A").Value = "Client IP"
            Cells(1, "B").Value = "Client Name"
            Cells(1, "C").Value = "Logged On User"
            Cells(1, "D").Value = "Mailbox Display Name"
            ' If yes, do the following:
            ' Iterate through the list of Exchange_Logon objects.
            For Each objExchange_Logon In listExchange_Logons
                ' Display some values of each Exchange_Logon object.
                'strResults = strResults & VbCrLf & """" & objExchange_Logon.ClientIP & """,""" & _
                '   """" & objExchange_Logon.ClientName & """,""" & _
                '   """" & objExchange_Logon.LoggedOnUserAccount & """,""" & _
                '   """" & objExchange_Logon.MailboxDisplayName & """"
                Cells(Cells(65536, "A").End(xlUp).Row + 1, "A").Value = objExchange_Logon.ClientIP
                Cells(Cells(65536, "B").End(xlUp).Row + 1, "B").Value = objExchange_Logon.ClientName
                Cells(Cells(65536, "C").End(xlUp).Row + 1, "C").Value = objExchange_Logon.LoggedOnUserAccount
                Cells(Cells(65536, "D").End(xlUp).Row + 1, "D").Value = objExchange_Logon.MailboxDisplayName
            Next
        Else
            ' If no Exchange_Logon instances were returned, ' display that.
            MsgBox "WARNING: No Exchange_Logon instances were returned."
        End If
    End If
    MsgBox "Done."
End Sub

           
         

Open in New Window Select All

Answer : Excel Macro when run needs to check colum "L" for the NTlogin and get the machinename and ip address from the exchange server.Where the user is using them.

I'm not quite sure of the versions, but I've assumed that
12 = 2007
11 = 2003

You'll have to check a couple manually to make sure I think....

Rob.

                       
         
           
             1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:

           
           
             Dim objExchangeLogons
Sub GetMailboxAccessPerUser()
    ' First populate the dictionary object with all logon sessions
    Set objExchangeLogons = CreateObject("Scripting.Dictionary")
    Call GetExchangeLogons
    
    ' Now go through column L to see if there is a match
    For intRow = 2 To Cells(65536, "L").End(xlUp).Row
        strNTLogin = Trim(LCase(Cells(intRow, "L").Value))
        If strNTLogin <> "" Then
            If objExchangeLogons.Exists(strNTLogin) Then
                Cells(intRow, "CP").Value = Split(objExchangeLogons(strNTLogin), "|")(0)
                Cells(intRow, "CQ").Value = Split(objExchangeLogons(strNTLogin), "|")(1)
                Cells(intRow, "CR").Value = Split(objExchangeLogons(strNTLogin), "|")(2)
            End If
        End If
    Next
    MsgBox "Done"
End Sub
Private Sub GetExchangeLogons()
    Const cWMINameSpace = "root/MicrosoftExchangeV2"
    Const cWMIInstance = "Exchange_Logon"
    cComputerName = "inex"  ' Exchange Server NETBIOS Name
    
    Dim strWinMgmts   ' Connection string for WMI
    Dim objWMIExchange  ' Exchange Namespace WMI object
    Dim listExchange_Logons ' ExchangeLogons collection
    Dim objExchange_Logon   ' A single ExchangeLogon WMI object
    
    ' Create the object string, indicating WMI (winmgmts), using the
    ' current user credentials (impersonationLevel=impersonate),
    ' on the computer specified in the constant cComputerName, and
    ' using the CIM namespace for the Exchange provider.
    strWinMgmts = "winmgmts:{impersonationLevel=impersonate}!//" & cComputerName & "/" & cWMINameSpace
    On Error Resume Next
    Set objWMIExchange = GetObject(strWinMgmts)
    ' Verify we were able to correctly set the object.
    If Err.Number <> 0 Then
        Err.Clear
        On Error GoTo 0
        MsgBox "ERROR: Unable to connect to the WMI namespace."
    Else
        ' The Resources that currently exist appear as a list of
        ' Exchange_Logon instances in the Exchange namespace.
        Set listExchange_Logons = objWMIExchange.InstancesOf(cWMIInstance)
        ' Were any Exchange_Logon Instances returned?
        If (listExchange_Logons.Count > 0) Then
            ' If yes, do the following:
            ' Iterate through the list of Exchange_Logon objects.
            For Each objExchange_Logon In listExchange_Logons
                ' Display some values of each Exchange_Logon object.
                If InStr(objExchange_Logon.LoggedOnUserAccount, "\") > 0 Then
                    strUsername = LCase(Mid(objExchange_Logon.LoggedOnUserAccount, InStr(objExchange_Logon.LoggedOnUserAccount, "\") + 1))
                Else
                    strUsername = LCase(objExchange_Logon.LoggedOnUserAccount)
                End If
                If Left(objExchange_Logon.ClientVersion, 2) = "12" Then
                	strClientVersion = "Office 2007"
                ElseIf Left(objExchange_Logon.ClientVersion, 2) = "11" Then
                	strClientVersion = "Office 2003"
                Else
                	strClientVersion = objExchange_Logon.ClientVersion
                End If
                objExchangeLogons.Add strUsername, objExchange_Logon.ClientIP & "|" & objExchange_Logon.MailboxDisplayName & "|" & strClientVersion
            Next
        Else
            ' If no Exchange_Logon instances were returned, ' display that.
            MsgBox "WARNING: No Exchange_Logon instances were returned."
        End If
    End If
    MsgBox "Done."
End Sub

           
         

Open in New Window Select All