none
Outlook meeting to EXCEL RRS feed

  • Question

  • I want sender email id , now i get only sender (Organizer) name.
    Please suggest any solution how to get sender email id

    Sub ListAppointments()


        Dim OlApp As Object
        Dim olNS As Object
        Dim olFolder As Object
        Dim olApt As Object
        Dim NextRow As Long
        Dim objAtt As Outlook.Attachment
        Dim saveFolder As String

        Set OlApp = CreateObject("Outlook.Application")

        Set olNS = OlApp.GetNamespace("MAPI")

        'Set olNS = olApp.GetNamespace("SMTP")

        Set olFolder = olNS.GetDefaultFolder(olFolderCalendar)    'olFolderCalendar

        Range("A1:H1").Value = Array("Subject", "Start", "End", "Location", "Body", "Organizer", "Attendees", "Attachment")

        NextRow = 2

        saveFolder = "D:\Dinesh\Outlook"

        For Each olApt In olFolder.Items
            Cells(NextRow, "A").Value = olApt.Subject
            Cells(NextRow, "B").Value = olApt.Start
            Cells(NextRow, "C").Value = olApt.End
            Cells(NextRow, "D").Value = olApt.Location
            Cells(NextRow, "E").Value = olApt.Body
            Cells(NextRow, "F").Value = olApt.Organizer
            Cells(NextRow, "G").Value = olApt.RequiredAttendees
    '        Cells(NextRow, "I").Value = olApt.SenderEmailAddress

            For Each objAtt In olApt.Attachments
                '            MsgBox "yes"
                objAtt.SaveAsFile saveFolder & "\" & objAtt.DisplayName
                Cells(NextRow, "H").Value = saveFolder & "\" & objAtt.DisplayName

            Next objAtt

            NextRow = NextRow + 1

        Next olApt

        Set olApt = Nothing
        Set olFolder = Nothing
        Set olNS = Nothing
        Set OlApp = Nothing

        Columns.AutoFit
    End Sub

    Tuesday, February 12, 2019 10:03 AM

All replies

  • You can easily download all appoints from Outlook to Excel.  Remember, set a reference to the Outlook library, since you are using Excel to communicate with Outlook.

     

     

     

    Private Sub Get_Appoinments()

     

        Dim mybk As Workbook

        Dim FolderCal As Outlook.Folder

        Dim ItemsApt As Outlook.Items

        Dim appt As Outlook.AppointmentItem

     

        i = 1

        Set mybk = ThisWorkbook

        Set FolderCal = Outlook.Application.GetNamespace("MAPI").GetDefaultFolder(olFolderCalendar)

        Set ItemsApt = FolderCal.Items

        For Each appt In ItemsApt

            mybk.Sheets(1).Cells(i, 1) = appt.Start

            mybk.Sheets(1).Cells(i, 2) = appt.End

            mybk.Sheets(1).Cells(i, 3) = appt.Subject

            mybk.Sheets(1).Cells(i, 4) = appt.Location

            mybk.Sheets(1).Cells(i, 5) = appt.Duration

            mybk.Sheets(1).Cells(i, 6) = appt.Size

            'mybk.Sheets(1).Cells(i, 7) = appt.Body

            i = i + 1

        Next

     

        MsgBox "OutLook Appointments Retrieved"

     

    End Sub

     


    MY BOOK

    Wednesday, February 13, 2019 3:20 PM