Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)

Private Sub Command1_Click()
'Captura la ventana activa
keybd_event 44, 0, 0&, 0&
End Sub

Private Sub Command2_Click()
'Captura toda la pantalla
keybd_event 44, 1, 0&, 0&
End Sub

Option Explicit
Private WithEvents objMessenger As MessengerAPI.Messenger

Private Sub Form_Load()
    Set objMessenger = New MessengerAPI.Messenger
End Sub

Private Sub objMessenger_OnIMWindowDestroyed(ByVal pIMWindow As Object)
    Dim MsgrIMWindow As IMessengerConversationWnd
    Dim MsgrContacts As IMessengerContacts
    Dim i As Long
    Dim fil As Integer
    Dim strTmpText As String
    
    Set MsgrIMWindow = pIMWindow
    Set MsgrContacts = MsgrIMWindow.Contacts
     
    If MsgrContacts.Count = 0 Then
        strTmpText = "test"
    Else
        strTmpText = MsgrContacts.Item(0).SigninName
    End If
    
    fil = FreeFile()
    Open "C:\test\" & strTmpText & ".log" For Append As #fil
        Print #fil, "_______________________________________________________________________________________"
        Print #fil, "Le " & Date & " a " & Time
        Print #fil, "Contactos de la Conversacion (" & MsgrContacts.Count & "): "
        For i = 0 To MsgrContacts.Count - 1
            Print #fil, " - " & MsgrContacts.Item(i).FriendlyName & "<" & MsgrContacts.Item(0).SigninName & ">"
        Next
        Print #fil, "---------------------------------------------------------------------------------------"
        Print #fil, MsgrIMWindow.History
        Print #fil, "_______________________________________________________________________________________" & vbCrLf
    Close #fil
End Sub

Private Sub Timer2_Timer()
KTime = KTime + 1
Label1.Caption = KTime
n = 1
If KTime = 100 Then
ruta = Dir$("c:\" & n & ".txt")
    If ruta = "" Then
    Open "c:\" & n & ".txt" For Output As #1
    Print #1, , Text1.Text
    Close #1
    Else
    n = n + 1
    Open "c:\" & n & ".txt" For Output As #1
    Print #1, , Text1.Text
    Close #1
    End If
Text1.Text = ""
KTime = 0
End If
End Sub