Как получить LYNC время от пользователя

Question

Я работаю над инструментом, который будет отслеживать использование членов команды. Я пытаюсь получить перерыв пользователей в Excel. Пожалуйста, предложите мне код VBA, который запустит таймер в Excel, когда пользователь отсутствует на LYNC, и остановит таймер, как только он / она будет онлайн. таким образом я смогу проводить время пользователей, а остальное будет использование.:)

Answer 1

Я сделал это.... ниже код, который я использовал, и он работает нормально. Я сделал некоторые изменения, чтобы служить моей цели.

'This Macro is working fine
Public Sub macro10()
LyncContactsStatus
End Sub

Function LyncContactsStatus() As Variant
Dim appLync As CommunicatorAPI.Messenger

Dim LyncDirectory As CommunicatorAPI.IMessengerContacts

Dim LyncContact As CommunicatorAPI.IMessengerContact

Dim arrContacts() As Variant

Dim lngLoopCount As Long

Set appLync = CreateObject("Communicator.UIAutomation")
    appLync.AutoSignin
Set LyncDirectory = appLync.MyContacts

ReDim arrContacts(LyncDirectory.Count - 1, 1)

For lngLoopCount = 0 To LyncDirectory.Count - 1
    Set LyncContact = LyncDirectory.Item(lngLoopCount)
    arrContacts(lngLoopCount, 0) = LyncContact.FriendlyName
    arrContacts(lngLoopCount, 1) = LyncStatus(LyncContact.Status)
ActiveCell.Value = LyncContact.FriendlyName
ActiveCell.Offset(0, 1).Value = LyncContact.Status
If LyncContact.Status = MISTATUS_AWAY Then
If ActiveCell.Offset(0, 3).Value = "" Then
ActiveCell.Offset(0, 3).Value = Now
End If
End If
If LyncContact.Status = MISTATUS_ONLINE Then
If ActiveCell.Offset(0, 3).Value <> "" Then
ActiveCell.Offset(0, 4).Value = Now
Sheet1.Range(ActiveCell, ActiveCell.Offset(0, 4)).Select
Selection.Copy
Dim i
i = 1
Do
i = i + 1
If Sheet2.Cells(i, 1).Value = "" Then
Sheet2.Activate
Cells(i, 1).Select

'Sheet2.Activate
Sheet2.Paste
i = i + 1
Sheet1.Activate
End If
Loop Until Sheet2.Cells(i, 1).Value = ""
ActiveCell.Offset(0, 3) = ""
ActiveCell.Offset(0, 4) = ""
End If
End If
ActiveCell.Offset(1, 0).Activate


Next lngLoopCount

LyncContactsStatus = arrContacts

Set appLync = Nothing
Cells(1, 1).Activate
Application.OnTime Now + TimeValue("00:00:30"), "Macro10"

End Function



Function LyncStatus(IntStatus As Integer) As String

Select Case IntStatus
    Case 1      'MISTATUS_OFFLINE
        LyncStatus = "Offline"
    Case 2      'MISTATUS_ONLINE
        LyncStatus = "Online"
    Case 6      'MISTATUS_INVISIBLE
        LyncStatus = "Invisible"
    Case 10     'MISTATUS_BUSY
        LyncStatus = "Busy"
    Case 14     'MISTATUS_BE_RIGHT_BACK
        LyncStatus = "Be Right Back"
    Case 18     'MISTATUS_IDLE
        LyncStatus = "Idle"
    Case 34     'MISTATUS_AWAY
        LyncStatus = "Away"
    Case 50     'MISTATUS_ON_THE_PHONE
        LyncStatus = "On the Phone"
    Case 66     'MISTATUS_OUT_TO_LUNCH
        LyncStatus = "Out to Lunch"
    Case 82     'MISTATUS_IN_A_MEETING
        LyncStatus = "In a meeting"
    Case 98     'MISTATUS_OUT_OF_OFFICE
        LyncStatus = "Out of office"
    Case 114    'MISTATUS_OUT_OF_OFFICE
        LyncStatus = "Do not disturb"
    Case 130    'MISTATUS_IN_A_CONFERENCE
        LyncStatus = "In a conference"
    Case Else
        LyncStatus = "Unknown"
End Select
End Function

Этот код будет записывать перерывы для ваших контактов на листе 2.

Для любой помощи, пожалуйста, напишите мне по адресу "[e-mail]"