elhacker.net cabecera Bienvenido(a), Visitante. Por favor Ingresar o Registrarse
¿Perdiste tu email de activación?.

 

 


Tema destacado: ¿Eres nuevo? ¿Tienes dudas acerca del funcionamiento de la comunidad? Lee las Reglas Generales


+  Foro de elhacker.net
|-+  Programación
| |-+  Scripting
| | |-+  Macro para crear una agenda
0 Usuarios y 1 Visitante están viendo este tema.
Páginas: [1] Ir Abajo Respuesta Imprimir
Autor Tema: Macro para crear una agenda  (Leído 1,841 veces)
Volturyon11

Desconectado Desconectado

Mensajes: 2


Ver Perfil
Macro para crear una agenda
« en: 18 Febrero 2019, 21:55 pm »

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!

Código:
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


En línea

Páginas: [1] Ir Arriba Respuesta Imprimir 

Ir a:  

WAP2 - Aviso Legal - Powered by SMF 1.1.21 | SMF © 2006-2008, Simple Machines