CommContactStatusLog - Complete Module

'CommunicatorStatusLog

'Excel macro to pull contact status information from Office Communicator

'Works with users not on your contact list
'Store contact display name & email on sheet 1
    'Use getAllMyContacts to retrieve all of your contacts instead of doing it manually
'Daily status sheet will be automatically created

Option Explicit
Public Sub getAllMyContacts()
     Dim myOC As New CommunicatorAPI.Messenger 'Office Communicator API
     Dim t: Set t = myOC.MyContacts
     Dim i As Integer
     Dim t1 As Variant

     Sheet1.Cells(1, 1).Value = "Display Name"
     Sheet1.Cells(1, 2).Value = "Email"

     i = 2
     For Each t1 In t
        Sheet1.Cells(i, 1).Value = t1.FriendlyName
        Sheet1.Cells(i, 2).Value = t1.SigninName
        i = i + 1
     Next
     MsgBox "Completed"
End Sub

Public Sub Main()
    Dim ContSheet, StatSheet As Worksheet
    Dim lrData, feRow As Long 'lrData= last row of data on contact sheet, feRow= first empty row on current status sheet
    Dim conName, conEmail, currStatus, prevStatus As String
    Dim colToUpdate 'As Long/String??
    Dim boolRepeat, boolExists As Boolean
    Dim i As Integer

    'Application.ScreenUpdating = False

    Call subAddWorksheet

    With ThisWorkbook
        Set ContSheet = .Worksheets(1)
        Set StatSheet = .Worksheets(2)
    End With

    lrData = ContSheet.Range("A" & Rows.Count).End(xlUp).Row
    feRow = StatSheet.Range("A" & Rows.Count).End(xlUp).Row + 1

    Do
        For i = 2 To lrData
            conName = ContSheet.Range("A" & i).Value
            conEmail = ContSheet.Range("B" & i).Value
            currStatus = funcGetStatus(conEmail)
            Set colToUpdate = StatSheet.Cells.Find(What:=conName, After:=Range("A1"), SearchOrder:=xlByColumns, SearchDirection:=xlPrevious)
            If colToUpdate Is Nothing Then
                colToUpdate = i 'using i for row number on contact list sheet and column number on status
                                     'sheet maintains consistent order
                boolExists = False
            Else
                colToUpdate = colToUpdate.Column
                boolExists = True
            End If

            If feRow > 2 Then 'if this isn't the first status of the sheet (row 1 = headers)
                prevStatus = StatSheet.Cells(feRow - 1, i).Value

                If currStatus <> prevStatus And boolRepeat = False Then
                    boolRepeat = True
                    Exit For
                End If

                If boolRepeat = True Then
                    'add conName to next empty column on row 1 (be sure to insert so sure to not overwrite any info)
                            '^ only if it doesn't already exist (add function to search for it?)
                    'add time to column a (save for end of macro?)
                    'add status to next empty row (feRow)

                    Call subLogStatus(conName, currStatus, colToUpdate, feRow, boolExists)
                End If
            ElseIf feRow = 2 Then
                'add conName to next empty column on row 1 (be sure to insert so sure to not overwrite any info)
                'add time to column a (save for end of macro?)
                'add status to next empty row (2, duh!)

                Call subLogStatus(conName, currStatus, colToUpdate, feRow, boolExists)
            End If
            If i = lrData And boolRepeat = True Then
                boolRepeat = False
            End If
        Next i
    Loop Until boolRepeat = False

    Application.ScreenUpdating = True

    Call subRepeat   'run macro to repeat process on schedule
End Sub

Private Function funcGetStatus(ByVal userEmail As String) As String
    Dim myOC As New CommunicatorAPI.Messenger 'Office Communicator API
    Dim curr_status As Integer
    Dim flag As Integer
    Dim stat As String

    stat = vbNullString
    curr_status = myOC.GetContact(userEmail, myOC.MyServiceId).Status
    Select Case curr_status
        Case 1
            stat = "Offline"
        Case 2
            stat = "Online"
        Case 6
            stat = "Invisible"
        Case 10
            stat = "Busy"
        Case 14
            stat = "Be Right Back"
        Case 18
            stat = "Inactive"
        Case 34
            stat = "Away"
        Case 50
            stat = "On the Phone"
        Case 66
            stat = "Out to Lunch"
        Case Else
            stat = "Unknown"
    End Select

    funcGetStatus = stat
End Function

Private Sub subLogStatus(conName, currStatus, colToUpdate, feRow, boolExists)
    If boolExists = False Then
        Cells(1, colToUpdate).EntireColumn.Insert
        Cells(1, colToUpdate).Value = conName
    End If
    Cells(feRow, colToUpdate).Value = currStatus

    Range("A" & feRow).Value = Format(Now, "hh:mm am/pm")
    Range("A" & feRow).Select
End Sub

Private Sub subAddWorksheet()
    'Insert new sheet to the right of name/email sheet (1)
    'Rename sheet with current date
    Dim SheetName As String

    SheetName = Format(Date, "mm-dd-yy")

    On Error GoTo AddNew
    ThisWorkbook.Sheets(SheetName).Activate
    Exit Sub

AddNew:
    ThisWorkbook.Sheets.Add After:=Worksheets(1)
    ActiveSheet.Name = SheetName
End Sub

Private Sub subRepeat()
    Application.OnTime Now + TimeValue("00:00:30"), "Main"
End Sub

Private Sub Auto_Open()
    'Run Main Sub
    Main
End Sub