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

Вход

Регистрация

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

 

= Мир MS Excel/Создание событие в календаре Outlook из Excel на один год - Мир MS Excel

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

Excel 2013
Добрый день, всем участникам форума.
Есть рабочий код (нашли на импортном форуме с небольшими своими доработками):
[vba]
Код
Sub ImportMeetingToCalendar()
    Dim objWorksheet As Excel.Worksheet
    Dim nLastRow As Integer
    Dim objOutlookApp As Outlook.Application
    Dim objCalendar As Outlook.Folder
    Dim objBirthdayEvent As Outlook.AppointmentItem
    Dim objRecurrencePattern As Outlook.RecurrencePattern
     
    'Get the specific sheet
        Set objWorksheet = ThisWorkbook.Sheets(1)
    nLastRow = objWorksheet.Range("A" & objWorksheet.Rows.Count).End(xlUp).Row

    Set objOutlookApp = CreateObject("Outlook.Application")
    Set objCalendar = objOutlookApp.Session.GetDefaultFolder(olFolderCalendar)

    For nRow = 2 To nLastRow
        Set objBirthdayEvent = objCalendar.Items.Add("IPM.Appointment")

        'Create events
        With objBirthdayEvent
            .AllDayEvent = True
            .BusyStatus = 0
            .Subject = objWorksheet.Range("A" & nRow)
            .Start = objWorksheet.Range("B" & nRow)
            .End = objWorksheet.Range("C" & nRow)
            .Body = objWorksheet.Range("D" & nRow)
            .Categories = objWorksheet.Range("E" & nRow)
            .ReminderSet = True
            .ReminderMinutesBeforeStart = objWorksheet.Range("F" & nRow).Value
            
         Set objRecurrencePattern = .GetRecurrencePattern
         objRecurrencePattern.RecurrenceType = olRecursYearly
            .Save
        End With
    Next
End Sub
[/vba]
Но он создает события на каждый год. Подскажите, пожалуйста, что-необходимо изменить чтобы события создавались только на один год?
 
Ответить
СообщениеДобрый день, всем участникам форума.
Есть рабочий код (нашли на импортном форуме с небольшими своими доработками):
[vba]
Код
Sub ImportMeetingToCalendar()
    Dim objWorksheet As Excel.Worksheet
    Dim nLastRow As Integer
    Dim objOutlookApp As Outlook.Application
    Dim objCalendar As Outlook.Folder
    Dim objBirthdayEvent As Outlook.AppointmentItem
    Dim objRecurrencePattern As Outlook.RecurrencePattern
     
    'Get the specific sheet
        Set objWorksheet = ThisWorkbook.Sheets(1)
    nLastRow = objWorksheet.Range("A" & objWorksheet.Rows.Count).End(xlUp).Row

    Set objOutlookApp = CreateObject("Outlook.Application")
    Set objCalendar = objOutlookApp.Session.GetDefaultFolder(olFolderCalendar)

    For nRow = 2 To nLastRow
        Set objBirthdayEvent = objCalendar.Items.Add("IPM.Appointment")

        'Create events
        With objBirthdayEvent
            .AllDayEvent = True
            .BusyStatus = 0
            .Subject = objWorksheet.Range("A" & nRow)
            .Start = objWorksheet.Range("B" & nRow)
            .End = objWorksheet.Range("C" & nRow)
            .Body = objWorksheet.Range("D" & nRow)
            .Categories = objWorksheet.Range("E" & nRow)
            .ReminderSet = True
            .ReminderMinutesBeforeStart = objWorksheet.Range("F" & nRow).Value
            
         Set objRecurrencePattern = .GetRecurrencePattern
         objRecurrencePattern.RecurrenceType = olRecursYearly
            .Save
        End With
    Next
End Sub
[/vba]
Но он создает события на каждый год. Подскажите, пожалуйста, что-необходимо изменить чтобы события создавались только на один год?

Автор - Anis625
Дата добавления - 21.02.2022 в 11:14
Anis625 Дата: Понедельник, 21.02.2022, 13:38 | Сообщение № 2
Группа: Проверенные
Ранг: Ветеран
Сообщений: 642
Репутация: 30 ±
Замечаний: 0% ±

Excel 2013
Решение нашлось такое:
[vba]
Код
Sub ImportMeetingToCalendar()
    Dim objWorksheet As Excel.Worksheet
    Dim nLastRow As Integer
    Dim objOutlookApp As Outlook.Application
    Dim objCalendar As Outlook.Folder
    Dim objBirthdayEvent As Outlook.AppointmentItem
    Dim objRecurrencePattern As Outlook.RecurrencePattern
    
    'Get the specific sheet
        Set objWorksheet = ThisWorkbook.Sheets(1)
    nLastRow = objWorksheet.Range("A" & objWorksheet.Rows.Count).End(xlUp).Row

    Set objOutlookApp = CreateObject("Outlook.Application")
    Set objCalendar = objOutlookApp.Session.GetDefaultFolder(olFolderCalendar)

    For nRow = 2 To nLastRow
        Set objBirthdayEvent = objCalendar.Items.Add("IPM.Appointment")

        'Create events
        With objBirthdayEvent
            .AllDayEvent = True
            .BusyStatus = 0
            .Subject = objWorksheet.Range("A" & nRow)
            .Start = objWorksheet.Range("B" & nRow)
            .End = objWorksheet.Range("C" & nRow)
            .Body = objWorksheet.Range("D" & nRow)
            .Categories = objWorksheet.Range("E" & nRow)
            .ReminderSet = True
            .ReminderMinutesBeforeStart = objWorksheet.Range("F" & nRow).Value
            
        'Set objRecurrencePattern = .GetRecurrencePattern
        'objRecurrencePattern.RecurrenceType = olRecursYearly
            .Save
        End With
    Next
End Sub
[/vba]

Закомментировал нижние строки


Сообщение отредактировал Anis625 - Понедельник, 21.02.2022, 13:38
 
Ответить
СообщениеРешение нашлось такое:
[vba]
Код
Sub ImportMeetingToCalendar()
    Dim objWorksheet As Excel.Worksheet
    Dim nLastRow As Integer
    Dim objOutlookApp As Outlook.Application
    Dim objCalendar As Outlook.Folder
    Dim objBirthdayEvent As Outlook.AppointmentItem
    Dim objRecurrencePattern As Outlook.RecurrencePattern
    
    'Get the specific sheet
        Set objWorksheet = ThisWorkbook.Sheets(1)
    nLastRow = objWorksheet.Range("A" & objWorksheet.Rows.Count).End(xlUp).Row

    Set objOutlookApp = CreateObject("Outlook.Application")
    Set objCalendar = objOutlookApp.Session.GetDefaultFolder(olFolderCalendar)

    For nRow = 2 To nLastRow
        Set objBirthdayEvent = objCalendar.Items.Add("IPM.Appointment")

        'Create events
        With objBirthdayEvent
            .AllDayEvent = True
            .BusyStatus = 0
            .Subject = objWorksheet.Range("A" & nRow)
            .Start = objWorksheet.Range("B" & nRow)
            .End = objWorksheet.Range("C" & nRow)
            .Body = objWorksheet.Range("D" & nRow)
            .Categories = objWorksheet.Range("E" & nRow)
            .ReminderSet = True
            .ReminderMinutesBeforeStart = objWorksheet.Range("F" & nRow).Value
            
        'Set objRecurrencePattern = .GetRecurrencePattern
        'objRecurrencePattern.RecurrenceType = olRecursYearly
            .Save
        End With
    Next
End Sub
[/vba]

Закомментировал нижние строки

Автор - Anis625
Дата добавления - 21.02.2022 в 13:38
boa Дата: Понедельник, 21.02.2022, 23:37 | Сообщение № 3
Группа: Друзья
Ранг: Ветеран
Сообщений: 543
Репутация: 166 ±
Замечаний: 0% ±

2013, 365
Здравствуйте,
я использую следующий файл
К сообщению приложен файл: Outlook_Rio_Ass.xlsb(49.8 Kb)


 
Ответить
СообщениеЗдравствуйте,
я использую следующий файл

Автор - boa
Дата добавления - 21.02.2022 в 23:37
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Создание событие в календаре Outlook из Excel на один год (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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