Excel для автоматизации электронной почты в Outlook с использованием определенных полей в листе Excel

Question

Я работаю над повышением моей эффективности на рабочем месте. Для этого есть задача отправить электронное письмо в список людей.

Для этого я создал следующий код. Хотите знать, если это можно улучшить? Этот код берет информацию из листа "Final_list" в рабочей книге, а заголовки находятся в строке 1.

Sub EmailToAll()

    Dim outlookApp As Outlook.Application
    Dim outlookMail As Outlook.MailItem

    Set outlookApp = CreateObject("Outlook.Application")
    Set outlookMail = outlookApp.CreateItem(olMailItem)



    Dim sh As Worksheet
    Dim RowCount As Integer

    Worksheets("Final_List").Activate

    RowCount = 2

    Set sh = ActiveSheet

    Do While IsEmpty(sh.Cells(RowCount, 1).Value) = False

        Set outlookApp = CreateObject("Outlook.Application")
        Set outlookMail = outlookApp.CreateItem(olMailItem)
        With outlookMail
                'MsgBox sh.Cells(RowCount, 7).Value
                .To = sh.Cells(RowCount, 7).Value
                .CC = sh.Cells(RowCount, 9).Value
                .BCC = Empty
                .Subject = "[Update]" & " " & sh.Cells(RowCount, 1).Value & "-" & sh.Cells(RowCount, 8).Value
                .BodyFormat = 2
                .HTMLBody = "Hello "
                '.Display
                '.Save
                '.Close
                .Send
                'MsgBox "Mail saved for" & sh.Cells(RowCount, 7).Value & "!"
                RowCount = RowCount + 1
        End With

    Loop

    Set outlookMail = Nothing
    Set outlookApp = Nothing
    MsgBox "All mails sent!"

End Sub

Answer 1

Вам не нужно создавать Outlook Object twice , Set outlookApp = CreateObject("Outlook.Application") и изменить Dim RowCount As Integer в Dim RowCount As Long

Также избегайте .Activate

Option Explicit
Sub EmailToAll()
    Dim outlookApp As Outlook.Application
    Dim outlookMail As Outlook.MailItem
    Dim RowCount As Long

    Set outlookApp = CreateObject("Outlook.Application")

    RowCount = 2

    With Worksheets("Final_List")
        Do While IsEmpty(Cells(RowCount, 1).Value) = False

            Set outlookMail = outlookApp.CreateItem(olMailItem)
            With outlookMail
                    .To = Cells(RowCount, 7).Value
                    .CC = Cells(RowCount, 9).Value
                    .BCC = Empty
                    .Subject = "[Update]" & " " & Cells(RowCount, 1).Value & "-" & Cells(RowCount, 8).Value
                    .BodyFormat = 2
                    .HTMLBody = "Hello "
                    .Send
            End With
            RowCount = RowCount + 1
        Loop
    End With

    Set outlookMail = Nothing
    Set outlookApp = Nothing

    MsgBox "All mails sent!"

End Sub

Answer 2

Не знаю точно, какие части этого вы хотели бы оптимизировать, но, посмотрев на ваш пример, вот пара вещей, которые я хотел бы изменить;

Единственные вещи, которые меняются в цикле, это получатели и строка темы, тело всегда одинаково (очевидно, я не знаю, что хранится в этих ячейках), но, возможно, вы могли бы просто создать строку получателей внутри цикла, которая должно работать нормально, если вы разделяете адреса электронной почты точками с запятой и отправляете одно письмо вместо нескольких?

Еще одна вещь, которую я хотел бы упомянуть, это то, что вы останавливаетесь, когда сталкиваетесь с пустой строкой, что означает, что цикл может не собрать всех получателей, если кто-то удалил эту строку по ошибке. Существует много гораздо более надежных способов определения местоположения конца данных, которые вы можете использовать.

Надеюсь, это поможет.