英文:
Send one email with all cell values
问题
在我的Excel表格中，如果符合我的条件，我有一列将填充单元格值。
我的代码遍历该列的每一行，如果一个单元格有值，它将自动发送一封电子邮件。
我希望代码能找出所有不为空的行，并只发送一封电子邮件，电子邮件的主题或正文显示从第一个到最后一个单元格的值。我希望主题行为从第一个单元格的值到最后一个单元格的值。
Sub Email()
Dim OL As Outlook.Application, Appoint As Outlook.AppointmentItem, ES As Worksheet, _
r As Long, i As Long, WB As ThisWorkbook, j As Long, k As Long
Set WB = ThisWorkbook
Set ES = WB.Sheets("Automatic Email Reminder")
r = ES.Cells(Rows.Count, 1).End(xlUp).Row
k = ES.Cells(Rows.Count, 1).End(xlUp).Row
Set OL = New Outlook.Application
For i = 4 To r
If ES.Cells(i, 6) = "" Then 'change this (5 for M&C, 6 for CP, 7 for Objection)
Else
Set Appoint = OL.CreateItem(olAppointmentItem)
With Appoint
.Subject = ES.Cells(i, 6).Value
.RequiredAttendees = "example@email.com"
.Start = ES.Cells(i, 8).Value
.Duration = 5
.ReminderMinutesBeforeStart = 2880
.Body = ES.Cells(i, 6).Value
.MeetingStatus = olMeeting
.Send
End With
End If
Next i
Set OL = Nothing
End Sub
英文:
In my Excel table, I have a column that will populate cell values if it meets my criteria.
My code goes through each of the rows in that column, and if a cell has a value it will populate a single email for each row to send automatically.
I would like the code to figure out all the rows that are not blank, and send only one email with the subject or body of the email showing the cell's value from first to last. I would like the subject line to be first cell value to last cell value.
Sub Email()
Dim OL As Outlook.Application, Appoint As Outlook.AppointmentItem, ES As Worksheet, _
r As Long, i As Long, WB As ThisWorkbook, j As Long, k As Long
Set WB = ThisWorkbook
Set ES = WB.Sheets("Automatic Email Reminder")
r = ES.Cells(Rows.Count, 1).End(xlUp).Row
k = ES.Cells(Rows.Count, 1).End(xlUp).Row
Set OL = New Outlook.Application
For i = 4 To r
If ES.Cells(i, 6) = "" Then 'change this (5 for M&C, 6 for CP, 7 for Objection)
Else
Set Appoint = OL.CreateItem(olAppointmentItem)
With Appoint
.Subject = ES.Cells(i, 6).Value
.RequiredAttendees = "example@email.com"
.Start = ES.Cells(i, 8).Value
.Duration = 5
.ReminderMinutesBeforeStart = 2880
.Body = ES.Cells(i, 6).Value
.MeetingStatus = olMeeting
.Send
End With
End If
Next i
Set OL = Nothing
End Sub
答案1
得分: 0
你需要在循环中创建一个预约主体字符串，之后可以发送一个会议邀请，例如：
Dim apptBody as String
For i = 4 To r
apptBody = apptBody & ES.Cells(i, 6).Value
Next i
Set Appoint = OL.CreateItem(olAppointmentItem)
With Appoint
.Subject = ES.Cells(i, 6).Value
.RequiredAttendees = "example@email.com"
.Start = ES.Cells(i, 8).Value
.Duration = 5
.ReminderMinutesBeforeStart = 2880
.Body = apptBody
.MeetingStatus = olMeeting
.Send
End With
英文:
You need to create an appointment body string in the loop after which you could send a meeting request, for example:
Dim apptBody as String
For i = 4 To r
apptBody = apptBody & ES.Cells(i, 6).Value
Next i
Set Appoint = OL.CreateItem(olAppointmentItem)
With Appoint
.Subject = ES.Cells(i, 6).Value
.RequiredAttendees = "example@email.com"
.Start = ES.Cells(i, 8).Value
.Duration = 5
.ReminderMinutesBeforeStart = 2880
.Body = apptBody
.MeetingStatus = olMeeting
.Send
End With
通过集体智慧和协作来改善编程学习和解决问题的方式。致力于成为全球开发者共同参与的知识库，让每个人都能够通过互相帮助和分享经验来进步。
评论