Buenas! Me gustaría hacer una consulta, resulta que tengo una macro de la cual saco datos del calendario de outlook, resulta que genero dos columnas:"Fecha" y "Asunto", lo que quiero hacer es algo como en esta imagen https://s.wincalendar.net/es/img/Agenda.png es decir, que en otra hoja se guarde el día y en la casilla de al lado todos los asuntos de ese día.
Un saludo!
Un saludo!
Código [Seleccionar]
Option Explicit
Sub ListAppointments()
Dim olApp As Object
Dim olNS As Object
Dim olFolder As Object
'Dim olApt As Object
Dim olApt
Dim NextRow As Long
Dim FromDate As Date
Dim ToDate As Date
FromDate = CDate("01/02/2019")
ToDate = CDate("28/02/2019")
On Error Resume Next
Set olApp = GetObject(, "Outlook.Application")
If Err.Number > 0 Then Set olApp = CreateObject("Outlook.Application")
On Error GoTo 0
Set olNS = olApp.GetNamespace("MAPI")
Set olFolder = olNS.GetDefaultFolder(9) 'olFolderCalendar
NextRow = 2
With Sheets("Datos") 'Change the name of the sheet here
.Range("A1:D1").Value = Array("Project", "Date", "Time spent", "Location")
For Each olApt In olFolder.Items
If (olApt.Start >= FromDate And olApt.Start <= ToDate) Then
If olApt.Subject Like "*I.V*" Or olApt.Subject Like "*E.V*" Then
.Cells(NextRow, "A").Value = olApt.Subject
.Cells(NextRow, "B").Value = CDate(olApt.Start)
.Cells(NextRow, "C").Value = olApt.End - olApt.Start
.Cells(NextRow, "C").NumberFormat = "HH:MM:SS"
.Cells(NextRow, "D").Value = olApt.Location
.Cells(NextRow, "E").Value = olApt.Categories
NextRow = NextRow + 1
End If
Else
End If
Next olApt
.Columns.AutoFit
End With
Set olApt = Nothing
Set olFolder = Nothing
Set olNS = Nothing
Set olApp = Nothing
End Sub
