Question

我有一个电子表格，该电子表格已设置为根据隐藏的工作表中列出的电子邮件地址自动每晚生成pdf和电子邮件。我目前必须为每个地址使单独的变量变暗，然后指定每个变量等于哪个单元格。这可行，但我觉得必须有更好的方法来做到这一点。具体来说，如果我要在列表中删除或添加其他地址，则不必添加或删除变暗的变量。这是我正在使用的代码：

Sub PDF_Email()


Dim OutLookApp As Object
Dim OutLookMailItem As Object
Dim myAttachment As Object
Dim MDir As String
Dim MName As String
Dim Address1 As String
Dim Address2 As String
Dim Address3 As String
Dim Address4 As String
Dim Address5 As String
Dim Address6 As String
Dim Address7 As String
Dim Address8 As String
Dim Address9 As String
Dim Address10 As String
Dim Address11 As String


Set OutLookApp = CreateObject("Outlook.application")
Set OutLookMailItem = OutLookApp.CreateItem(0)
Set myAttachment = OutLookMailItem.Attachments

Address1 = Worksheets("EmailList").Cells(1, 1).Value
Address2 = Worksheets("EmailList").Cells(2, 1).Value


'Prevent Macro from running if different user
Const AllowedName As String = "nbelair"

If Environ("username") <> AllowedName Then
    Exit Sub
End If


MName = ActiveSheet.Name & " " & Format(Now() - 1, "dddd, mmmm, d, yyyy")
MDir = ActiveWorkbook.Path

ChDir "Y:\SMHC Management Team\Daily Labor Management\Dashboard\Archived 
Dashboards" 'Update to
ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"Y:\SMHC Management Team\Daily Labor Management\Dashboard\Archived  
Dashboards\" & MName & ".pdf", OpenAfterPublish:=True 'Update



With OutLookMailItem
.To = Address1 & ";" & Address2
.Subject = "SMHC Daily Labor Management Dashboard - " & Format(Now() - 1, 
"dddd, mmmm, d, yyyy")
.Body = "Attached please find the SMHC Daily Labor Management Dashboard for 
" _
    & Format(Now() - 1, "dddd, mmmm, d, yyyy") & ".  You are receiving this 
email because you are currently " _
    & "on the distribution list for this report.  If you have any questions 
" _
    & "or concerns regarding this email or report please let me know by 
responding to this email or contacting me at 207 467 6983."

myAttachment.Add "Y:\SMHC Management Team\Daily Labor 
Management\Dashboard\Archived Dashboards\" & MName & ".pdf"
.Display
.Send
End With

'Clear Outlook Variables
Set OutLookMailItem = Nothing
Set OutLookApp = Nothing

'Quit
ThisWorkbook.Saved = True
Application.Quit

End Sub

作为编码的新手，我将不胜感激别人可能有的任何想法或建议。我很快就爱上了编码，并欢迎有机会学习新知识！

谢谢

Answer 1

第一个循环建立To:的字符串

第二个循环构建CC:的字符串

电子邮件地址跨越F的列To和G的列CC

Dim i As Integer
Dim EmailTo As String
Dim EmailCC As String

For i = 2 To 30
    EmailTo = EmailTo & ThisWorkbook.Sheets("Email").Range("F" & i) & ";"
Next i

For i = 2 To 30
    EmailCC = EmailCC & ThisWorkbook.Sheets("Email").Range("G" & i) & ";"
Next i


ThisWorkbook.Sheets("Dash").Range("C2:Q63").Select
ThisWorkbook.EnvelopeVisible = True


    With ThisWorkbook.Sheets("Dash").MailEnvelope
        .Introduction = ""
        .Item.To = EmailTo
        .Item.CC = EmailCC
        .Item.Subject = "Subject " & Date
        .Item.Display
    End With

改进从电子表格获取电子邮件地址的过程

1 个答案: