¿Cómo contar las horas/días/semanas dedicadas a una cita o reunión en Outlook?
Supongamos que hay muchas citas y reuniones en un calendario en Outlook. ¿Y si ahora quieres contar las horas/días/semanas dedicadas a estas citas y reuniones, tienes alguna idea? Este artículo presentará una macro VBA para ayudarte.
Cuenta las horas/días/semanas dedicadas a una cita o reunión con VBA
Cuenta las horas/días/semanas dedicadas a una cita o reunión con VBA
Este método presentará una macro VBA para contar las horas o minutos dedicados a la cita o reunión especificada en Outlook. Por favor, sigue los siguientes pasos:
1. Cambia a la carpeta del Calendario y haz clic para seleccionar la cita o reunión en la que contarás las horas dedicadas.
2. Presiona simultáneamente las teclas Alt + F11 para abrir la ventana de Microsoft Visual Basic para Aplicaciones.
3. Haz clic en Insertar > Módulo, y luego pega el siguiente código VBA en la ventana del Módulo que se abre.
VBA: Cuenta las horas/minutos dedicados a una cita o reunión en Outlook
Sub CountTimeSpent()
Dim oOLApp As Outlook.Application
Dim oSelection As Outlook.Selection
Dim oItem As Object
Dim iDuration As Long
Dim iTotalWork As Long
Dim iMileage As Long
Dim iResult As Integer
Dim bShowiMileage As Boolean
bShowiMileage = False
iDuration = 0
iTotalWork = 0
iMileage = 0
On Error Resume Next
Set oOLApp = CreateObject("Outlook.Application")
Set oSelection = oOLApp.ActiveExplorer.Selection
For Each oItem In oSelection
If oItem.Class = olAppointment Then
iDuration = iDuration + oItem.Duration
iMileage = iMileage + oItem.Mileage
ElseIf oItem.Class = olTask Then
iDuration = iDuration + oItem.ActualWork
iTotalWork = iTotalWork + oItem.TotalWork
iMileage = iMileage + oItem.Mileage
ElseIf oItem.Class = Outlook.olJournal Then
iDuration = iDuration + oItem.Duration
iMileage = iMileage + oItem.Mileage
Else
iResult = MsgBox("Please select some Calendar, Task or Journal items at first!", vbCritical, "Items Time Spent")
Exit Sub
End If
Next
Dim MsgBoxText As String
MsgBoxText = "Total time spent: " & vbNewLine & iDuration & " minutes"
If iDuration > 60 Then
MsgBoxText = MsgBoxText & HoursMsg(iDuration)
End If
If iTotalWork > 0 Then
MsgBoxText = MsgBoxText & vbNewLine & vbNewLine & "Total work recorded; " & vbNewLine & iTotalWork & " minutes"
If iTotalWork > 60 Then
MsgBoxText = MsgBoxText & HoursMsg(iTotalWork)
End If
End If
If bShowiMileage = True Then
MsgBoxText = MsgBoxText & vbNewLine & vbNewLine & "Total iMileage; " & iMileage
End If
iResult = MsgBox(MsgBoxText, vbInformation, "Items Time spent")
ExitSub:
Set oItem = Nothing
Set oSelection = Nothing
Set oOLApp = Nothing
End Sub
Function HoursMsg(TotalMinutes As Long) As String
Dim iHours As Long
Dim iMinutes As Long
iHours = TotalMinutes \ 60
iMinutes = TotalMinutes Mod 60
HoursMsg = " (" & iHours & " Hours and " & iMinutes & " Minutes)"
End Function
4. Presiona la tecla F5 o haz clic en el botón Ejecutar para ejecutar esta macro VBA.
Ahora aparecerá un cuadro de diálogo que muestra cuántas horas/minutos se dedicaron a la cita/reunión seleccionada. Ver captura de pantalla:

Nota: Puedes seleccionar varias citas o reuniones al mismo tiempo para contar el total de horas/minutos dedicados a ellas con este código VBA.
Artículos relacionados
Cuenta el número total de conversaciones en una carpeta en Outlook
Cuenta el número total de adjuntos en correos electrónicos seleccionados en Outlook
Cuenta el número de destinatarios en los campos Para, Cc y CCO en Outlook
Cuenta el número de correos electrónicos por remitente en Outlook
Las mejores herramientas de productividad para Office
Últimas noticias: ¡Kutools para Outlook lanza una versión gratuita!
¡Descubre el nuevo Kutools para Outlook con más de100 funciones increíbles! ¡Haz clic para descargarlo ahora!
📧 Automatización de Email: Respuesta automática (disponible para POP e IMAP) / Programar envío de correos electrónicos / CC/BCC automático por regla al enviar correo / Reenvío automático (Regla avanzada) / Agregar saludo automáticamente / Dividir automáticamente correos con varios destinatarios en mensajes individuales ...
📨 Gestión de Email: Recuperar correos electrónicos / Bloquear correos sospechosos por asunto y otros criterios / Eliminar correos electrónicos duplicados / Búsqueda Avanzada / Organizar carpetas ...
📁 Adjuntos Pro: Guardar en lote / Desanexar en lote / Comprimir en lote / Guardar automáticamente / Desconectar automáticamente / Auto Comprimir ...
🌟 Magia de la Interfaz: 😊Más emojis atractivos y geniales / Recibe avisos cuando lleguen emails importantes / Minimiza Outlook en vez de cerrarlo ...
👍 Funciones de un solo clic: Responder a Todos con Adjuntos / Correos electrónicos Anti-Phishing / 🕘Mostrar la zona horaria del remitente ...
👩🏼🤝👩🏻 Contactos y Calendario: Agregar en lote contactos de correos seleccionados / Dividir un grupo de contactos en grupos individuales / Eliminar recordatorio de cumpleaños ...
Utiliza Kutools en tu idioma preferido; ¡compatible con Inglés, Español, Alemán, Francés, Chino y más de40 idiomas adicionales!

