Блог

Главная - Вопросы по программированию - Создайте встречу в Outlook, ЕСЛИ ячейка содержит определенный текст

Создайте встречу в Outlook, ЕСЛИ ячейка содержит определенный текст

#excel #vba #outlook

#excel #vba #outlook

Вопрос:

Я пытаюсь создать новую встречу Outlook с данными Excel, если ячейка содержит слово «Да».

 Sub AddAppointments()

' Create the Outlook session
Set myOutlook = CreateObject("Outlook.Application")

' Start at row 4    
r = 4

Do Until Trim(Cells(r, 1).Value) = ""

    ' Create the AppointmentItem
    Set myApt = myOutlook.CreateItem(1)

    ' Set the appointment properties
    myApt.Subject = Cells(r, 3).Value
    myApt.Start = Cells(r, 7)   Cells(r, 8).Value

    If Trim(Cells(r, 5).Value) = "" Then
        myApt.BusyStatus = 2
    Else
        myApt.BusyStatus = Cells(r, 5).Value
    End If

    If Cells(r, 10).Value = "Yes" Then
        myApt.ReminderSet = True
    Else
        myApt.ReminderSet = False
    End If

    myApt.Body = "£" amp; Cells(r, 6).Value
        myApt.Save
        r = r   1
    Loop
End Sub

Если ячейка содержит «Нет» или «N / A», она останавливается. Я бы хотел, чтобы это игнорировалось.

Комментарии:

1. Всегда используйте Option Explicit и полностью объявляйте свои переменные. Вместо того, чтобы использовать Do цикл, получите количество строк, а затем используйте FOR цикл. Всегда используйте квалифицированную рабочую книгу / листы. Когда вы говорите Cells(r, 10).Value , вы смотрите на любой активный лист (который может быть не тем листом, который вы хотите просмотреть). Кроме того, If Cells(r, 10).Value = "Yes" Then должно быть первое, что вы делаете в цикле

2. Я взял большую часть этого кода из другого места, я никогда раньше не пробовал ничего подобного — я только хочу посмотреть на активные листы, но понятия не имею о Option Explicit?

3. Option Explicit заставляет вас объявлять ваши переменные. Если вы не объявляете переменную, в VBA переменная устанавливается как variant type . Это может привести к нежелательным результатам

4. Кроме того, FOR цикл — как бы мне это включить? Как я уже сказал, я понятия не имею, как это сделать.

5. Простой рабочий пример был загружен в dropbox. пожалуйста, просмотрите ее. Для определенных параметров это еще предстоит проработать. < dropbox.com/s/zii6rghcc99zfqt /… >

Ответ №1:

Ниже прилагается примерный снимок рабочего листа. введите описание изображения здесь

Следующий пример кода работает для меня.

 Option Explicit    
Sub test2()

        Dim OL As Outlook.Application, Appoint As Outlook.AppointmentItem, ES As Worksheet, _
        r As Long, i As Long, WB As ThisWorkbook

        Set WB = ThisWorkbook
        Set ES = WB.Sheets("Sheet1")
        r = ES.Cells(Rows.Count, 1).End(xlUp).Row
        Set OL = New Outlook.Application
    For i = 2 To r
        Set Appoint = OL.CreateItem(olAppointmentItem)
        With Appoint
            .Subject = ES.Cells(i, 1).Value
            .Start = ES.Cells(i, 2).Value
            .End = ES.Cells(i, 3).Value
            .Location = ES.Cells(i, 4).Value
            .AllDayEvent = ES.Cells(i, 5).Value
            .Categories = ES.Cells(i, 6).Value amp; " Category"
            .BusyStatus = ES.Cells(i, 7).Value
            .ReminderSet = True
            .ReminderMinutesBeforeStart = 60
            .Body = ES.Cells(i, 8).Value
            .Save
        End With
    Next i
     Set OL = Nothing

    End Sub

Редактировать

Основываясь на комментариях OP, вводим «Нуждается в проверке» Column10 . Пересмотренный код работает следующим образом.

 Sub test3()

    Dim OL As Outlook.Application, Appoint As Outlook.AppointmentItem, ES As Worksheet, _
    r As Long, i As Long, WB As ThisWorkbook

    Set WB = ThisWorkbook
    Set ES = WB.Sheets("Sheet1")
    r = ES.Cells(Rows.Count, 1).End(xlUp).Row
    Set OL = New Outlook.Application
For i = 2 To r
    If ES.Cells(i, 10) = "Yes" Then
    Set Appoint = OL.CreateItem(olAppointmentItem)
    With Appoint
        .Subject = ES.Cells(i, 1).Value
        .Start = ES.Cells(i, 2).Value
        .End = ES.Cells(i, 3).Value
        .Location = ES.Cells(i, 4).Value
        .AllDayEvent = ES.Cells(i, 5).Value
        .Categories = ES.Cells(i, 6).Value amp; " Category"
        .BusyStatus = ES.Cells(i, 7).Value
        .ReminderSet = True
        .ReminderMinutesBeforeStart = 60
        .Body = ES.Cells(i, 8).Value
        .Save
    End With
    End If
Next i
 Set OL = Nothing

End Sub

Комментарии:

1. Как я могу заставить его игнорировать ячейку с False в?

2. @ffc2004 Я попытаюсь учесть эту ситуацию. Какой элемент вы хотите проверить. Это BusyStatus.

3. На рабочем листе, в котором я пытаюсь его использовать, есть столбец с именем «Нужно проверить» — я хочу, чтобы он добавлял встречу только для тех, кто говорит «Да»

4. @ffc2004 Пожалуйста, посмотрите мою правку. включение условия столбца «Отслеживание потребностей».

5. Я получаю «Ошибка компиляции — пользовательский тип не определен» для раздела OL As Outlook.Application

Ответ №2:

Как насчет этого?

 Sub AppointmentAutomation()

    Dim OutApp As Object
    Set OutApp = CreateObject("Outlook.Application")

    Dim oAppt As AppointmentItem
    Dim oPattern As RecurrencePattern
    Set oAppt = OutApp.CreateItem(olAppointmentItem)
    Set oPattern = oAppt.GetRecurrencePattern
    With oPattern
        .RecurrenceType = olRecursWeekly
        .DayOfWeekMask = olMonday
        .PatternStartDate = Worksheets("Sheet1").Range("A2")
        .PatternEndDate = Worksheets("Sheet1").Range("B2")
        .Duration = 60
        .StartTime = Worksheets("Sheet1").Range("C2")
        .EndTime = Worksheets("Sheet1").Range("D2")
    End With
    oAppt.Subject = Worksheets("Sheet1").Range("E2")
    oAppt.Save
    oAppt.Display

Set OutApp = Nothing

End Sub

введите описание изображения здесь