Отправлять несколько листов в одной книге с помощью макроса VBA через Outlook Email? - PullRequest
Новая
       11

Отправлять несколько листов в одной книге с помощью макроса VBA через Outlook Email?

0 голосов
/ 08 октября 2018

Я хотел бы скопировать несколько рабочих листов (например, Sheet71, Sheet76, Sheet60 и Sheet77), которые находятся в одной рабочей книге, в другую рабочую книгу, чтобы отправить электронное письмо получателю, которое указано в моем листе ключей электронной почты на листе.71.

Эти электронные письма будут отправлены отдельным лицам с описанием их бонусной выплаты.

Поэтому очень важно, чтобы получатели получали только своих или тех, за кого они несут ответственность.

Я выяснил, как отправить один лист на одного получателя, но не могу понять, как это сделать с несколькими листами без использования имени на листе (матрица Пирса, Матрица Шаффа, Матрица Гэмбла и Матрица Рида) по сравнению сSheet71, Sheet76, Sheet60 и Sheet77 в VBA.

Мне нужно иметь возможность ссылаться в макросе на номер листа, а не на имя, потому что происходит оборот.

Ниже приведенкод, который я написал, чтобы отправить электронное письмо одному человеку на листе электронной почты (Sheet81) с одним листом, но он отправляет только лист 71.

Я пробовал ключевое слово Array и несколько других ключевых слов, но не могу заставить его работать.

Мне нужно сослаться наНомер листа, а не имя листа, потому что имена меняются при замене людей.

Я бы предпочел сделать копию, как показано в приведенном ниже коде, но я открыт, чтобы попробовать команду Select, если это сработает.

Sub Mail()

Dim OutlookApp As Object
Dim Mess As Object, Recip
Recip = Sheet81.[C35].Value
newDate = MonthName(Month(DateAdd("m", -1, Date)), False)

 ' Make a copy of the active worksheet
' and save it to a temporary file
Sheet71.Copy
Set WB = ActiveWorkbook

Filename = WB.Worksheets(1).Name
On Error Resume Next
Kill "C:\" & Filename
On Error GoTo 0
WB.SaveAs Filename:="C:\" & Filename

Set OutlookApp = CreateObject("Outlook.Application")
Set Mess = OutlookApp.CreateItem(olMailItem)
With Mess
.Subject = (newDate + " Matrix")
.Body = ("Attached is your " + newDate + " bonus matrix.  Thanks! Neil")
.to = Recip
.Attachments.Add WB.FullName
.Display
.Send
End With
ActiveWorkbook.Close

Set OutlookApp = Nothing
Set Mess = Nothing
End Sub

Ответы [ 2 ]

0 голосов
/ 09 октября 2018

Вы можете использовать WB.Worksheets(1).CodeName для ссылки на номер листа.

свойство CodeName доступно только для чтения. Вы можете ссылаться на конкретный лист как на Рабочие листы («Фред»). Диапазон («А1») гдеFred - это свойство .Name или как Sheet1.Range («A1»), где Sheet1 - это кодовое имя рабочего листа.

Для получения дополнительной информации вы можете обратиться по этой ссылке:

Имена листов вкладок Excel и имена листов Visual Basic

0 голосов
/ 08 октября 2018

В этом методе я решил создать новую подпрограмму под названием sendMultMails.Это создаст коллекцию рабочих листов, которые вы решите добавить.Поскольку вы не хотите использовать имя листа в качестве ссылки, я использовал лист CodeName .

Итак, добавьте ваши листы в коллекцию и зациклите эту коллекцию.Внутри цикла вы будете вызывать другую подпрограмму Mail, передавая лист в качестве параметра. 

Sub sendMultMails()

    Dim wsColl As New Collection, ws As Worksheet

    Rem: Add your worksheets to the collection via the worksheet's CodeName
    With wsColl
        .Add Sheet71
        .Add Sheet76
        .Add Sheet60
        .Add Sheet77
    End With

    Rem: loop through each collection item, calling the Mail Routine
    For Each ws In wsColl
        Mail ws
    Next

End Sub


Rem: Added an argument for you to pass the ws obj to this routine
Sub Mail(ws As Worksheet)

    Dim OutlookApp As Object
    Dim Mess As Object, Recip
    Recip = ws.Range("C35").Value
    newDate = MonthName(Month(DateAdd("m", -1, Date)), False)

     ' Make a copy of the active worksheet
    ' and save it to a temporary file
    ws.Copy
    Set WB = ActiveWorkbook

    Filename = WB.Worksheets(1).Name
    On Error Resume Next
    Kill "C:\" & Filename
    On Error GoTo 0
    WB.SaveAs Filename:="C:\" & Filename

    Set OutlookApp = CreateObject("Outlook.Application")
    Set Mess = OutlookApp.CreateItem(olMailItem)
    With Mess
    .Subject = (newDate + " Matrix")
    .Body = ("Attached is your " + newDate + " bonus matrix.  Thanks! Neil")
    .to = Recip
    .Attachments.Add WB.FullName
    .Display
    .Send
    End With
    ActiveWorkbook.Close

    Set OutlookApp = Nothing
    Set Mess = Nothing

End Sub
...