Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Экспорт календарей Outlook VBA с периодом диапазона - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Экспорт календарей Outlook VBA с периодом диапазона (Макросы/Sub)
Экспорт календарей Outlook VBA с периодом диапазона
Anis625 Дата: Среда, 19.01.2022, 11:48 | Сообщение № 1
Группа: Проверенные
Ранг: Ветеран
Сообщений: 642
Репутация: 30 ±
Замечаний: 0% ±

Excel 2013
Добрый день, всем участникам форума.
Уперся в стенку с задачей по экспорту календарей Outlook в Excel. Пробовал через стандартный способ экспорта в самом Outlook. Получается, но только основной свой календарь экспортируется. Календарь с предоставленным мне полным доступом от другого сотрудника не скачивается. Пробовал через VBA код (нашел в интернете):
[vba]
Код
Sub ListAppointments2()
Dim olApp As Object
Dim olNS As Object
Dim olFolder As Object
Dim olApt As Object
Dim NextRow As Long
Dim FromDate As Date
Dim ToDate As Date

'FromDate = CDate("04/01/2022")
'ToDate = CDate("04/12/2022")
    FromDate = CDate(InputBox("Enter start date"))
    ToDate = CDate(InputBox("Enter end date"))

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("Лист1") 'Change the name of the sheet here
.Range("A1:D1").Value = Array("Subject", "StartDate", "EndDate", "Category")
For Each olApt In olFolder.Items
If (olApt.Start >= FromDate And olApt.Start <= ToDate) 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
Else
End If
Next olApt
.Columns.AutoFit
End With

Set olApt = Nothing
Set olFolder = Nothing
Set olNS = Nothing
Set olApp = Nothing
End Sub
[/vba]
Ругается на эту строку:
[vba]
Код
If (olApt.Start >= FromDate And olApt.Start <= ToDate) Then
[/vba]
Вроде правильный формат даты указываю и период корректный, все равно ошибка.

Пробовал такой код:
[vba]
Код
Option Explicit

Sub ListAppointments()
    Dim olApp As Object
    Dim olNS As Object
    Dim olFolder As Object
    Dim olApt As Object
    Dim NextRow As Long
    Dim FromDate As Date
    Dim ToDate As Date

    FromDate = CDate("01/01/2021")
    ToDate = Now()

    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("Лист1") 'Change the name of the sheet here
        .Range("A1:G1").Value = Array("Project", "Date", "Time spent", "Location", "Categories", "Start Hour", "End Hour")
        For Each olApt In olFolder.Items
            If (olApt.Start >= FromDate And olApt.Start <= ToDate) 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
                .Cells(NextRow, "F").Value = olApt.Start
                .Cells(NextRow, "G").Value = olApt.End
                NextRow = NextRow + 1
            Else
            End If
        Next olApt
        .Columns.AutoFit
    End With

    Set olApt = Nothing
    Set olFolder = Nothing
    Set olNS = Nothing
    Set olApp = Nothing
End Sub
[/vba]
Та же ошибка на аналогичную строку:
[vba]
Код
If (olApt.Start >= FromDate And olApt.Start <= ToDate) Then
[/vba]

Подскажите, пожалуйста, в чем может быть ошибка? Поможет ли этот код получить данные с расшаренного календаря?
 
Ответить
СообщениеДобрый день, всем участникам форума.
Уперся в стенку с задачей по экспорту календарей Outlook в Excel. Пробовал через стандартный способ экспорта в самом Outlook. Получается, но только основной свой календарь экспортируется. Календарь с предоставленным мне полным доступом от другого сотрудника не скачивается. Пробовал через VBA код (нашел в интернете):
[vba]
Код
Sub ListAppointments2()
Dim olApp As Object
Dim olNS As Object
Dim olFolder As Object
Dim olApt As Object
Dim NextRow As Long
Dim FromDate As Date
Dim ToDate As Date

'FromDate = CDate("04/01/2022")
'ToDate = CDate("04/12/2022")
    FromDate = CDate(InputBox("Enter start date"))
    ToDate = CDate(InputBox("Enter end date"))

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("Лист1") 'Change the name of the sheet here
.Range("A1:D1").Value = Array("Subject", "StartDate", "EndDate", "Category")
For Each olApt In olFolder.Items
If (olApt.Start >= FromDate And olApt.Start <= ToDate) 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
Else
End If
Next olApt
.Columns.AutoFit
End With

Set olApt = Nothing
Set olFolder = Nothing
Set olNS = Nothing
Set olApp = Nothing
End Sub
[/vba]
Ругается на эту строку:
[vba]
Код
If (olApt.Start >= FromDate And olApt.Start <= ToDate) Then
[/vba]
Вроде правильный формат даты указываю и период корректный, все равно ошибка.

Пробовал такой код:
[vba]
Код
Option Explicit

Sub ListAppointments()
    Dim olApp As Object
    Dim olNS As Object
    Dim olFolder As Object
    Dim olApt As Object
    Dim NextRow As Long
    Dim FromDate As Date
    Dim ToDate As Date

    FromDate = CDate("01/01/2021")
    ToDate = Now()

    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("Лист1") 'Change the name of the sheet here
        .Range("A1:G1").Value = Array("Project", "Date", "Time spent", "Location", "Categories", "Start Hour", "End Hour")
        For Each olApt In olFolder.Items
            If (olApt.Start >= FromDate And olApt.Start <= ToDate) 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
                .Cells(NextRow, "F").Value = olApt.Start
                .Cells(NextRow, "G").Value = olApt.End
                NextRow = NextRow + 1
            Else
            End If
        Next olApt
        .Columns.AutoFit
    End With

    Set olApt = Nothing
    Set olFolder = Nothing
    Set olNS = Nothing
    Set olApp = Nothing
End Sub
[/vba]
Та же ошибка на аналогичную строку:
[vba]
Код
If (olApt.Start >= FromDate And olApt.Start <= ToDate) Then
[/vba]

Подскажите, пожалуйста, в чем может быть ошибка? Поможет ли этот код получить данные с расшаренного календаря?

Автор - Anis625
Дата добавления - 19.01.2022 в 11:48
R_Dmitry Дата: Четверг, 20.01.2022, 23:58 | Сообщение № 2
Группа: Друзья
Ранг: Участник
Сообщений: 74
Репутация: 34 ±
Замечаний: 0% ±

2010
Добрый день так а какое значение при ошибке в переменной olApt.Start ?


{Skype : RDG_Dmitry} Если программа тебе понятна,значит она уже устарела
 
Ответить
СообщениеДобрый день так а какое значение при ошибке в переменной olApt.Start ?

Автор - R_Dmitry
Дата добавления - 20.01.2022 в 23:58
Anis625 Дата: Пятница, 21.01.2022, 06:51 | Сообщение № 3
Группа: Проверенные
Ранг: Ветеран
Сообщений: 642
Репутация: 30 ±
Замечаний: 0% ±

Excel 2013
R_Dmitry,
Значение чего?
 
Ответить
СообщениеR_Dmitry,
Значение чего?

Автор - Anis625
Дата добавления - 21.01.2022 в 06:51
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Экспорт календарей Outlook VBA с периодом диапазона (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2022 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!