Excel的VBA通过outlook发邮件里面加入excel里面指定的数据发送给指定的人 40
如下图，所有内容（不包含status为Closed的数据）会通过邮件发给指定的人，比如我是YuYuanDing（标题为Assignee的数据），所有整行包括YuYuanD...
如下图，所有内容（不包含status为Closed的数据）会通过邮件发给指定的人，比如我是YuYuan Ding（标题为Assignee的数据），所有整行包括YuYuan Ding的数据包括表格里的标题就会发给YuYuan Ding（不包括status为Closed的数据），现在我只做到可以发给指定的人，就是Sheet2里面的Assignee数据通过合并进Sheet4来发送，却不知道怎么把和指定的人相关的所有status不是Closed表格数据内容放进邮件的内容里,求大神帮打下代码，万分感谢！
Sub Email()
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Sheets("Sheet2").SelectActiveSheet.Range($A$1:$J$6).AutoFilter Field:=3,Criterial1:=_
"=In Progress", Operator:=xlOr,Criteria2:="=Resolved"Columns("G:G").Select
Selection.Copy
Sheets("Sheet4").Select
Columns("A:A").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveSheet.Range("$A$1:$A$1048574").RemoveDuplicates Columns:=1, Header:=_
xlYes
Sheets("Sheet4").Select
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
On Error GoTo cleanup
For Each cell In Columns("A").Cells.SpecialCells(xlCellTypeConstants)
If (Cells(cell.Row, "A").Value) <> "" Then
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = cell.Value
.Subject = "Please looking ofr these defects"
.Body = "Hi," & Cells(cell.Row, "A").Value _
& vbNewLine & vbNewLine & _
"These are the defects."
.Send
End With
On Error GoTo 0
Set OutMail = Nothing
End If
Next cell
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub 展开
Sub Email()
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Sheets("Sheet2").SelectActiveSheet.Range($A$1:$J$6).AutoFilter Field:=3,Criterial1:=_
"=In Progress", Operator:=xlOr,Criteria2:="=Resolved"Columns("G:G").Select
Selection.Copy
Sheets("Sheet4").Select
Columns("A:A").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveSheet.Range("$A$1:$A$1048574").RemoveDuplicates Columns:=1, Header:=_
xlYes
Sheets("Sheet4").Select
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
On Error GoTo cleanup
For Each cell In Columns("A").Cells.SpecialCells(xlCellTypeConstants)
If (Cells(cell.Row, "A").Value) <> "" Then
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = cell.Value
.Subject = "Please looking ofr these defects"
.Body = "Hi," & Cells(cell.Row, "A").Value _
& vbNewLine & vbNewLine & _
"These are the defects."
.Send
End With
On Error GoTo 0
Set OutMail = Nothing
End If
Next cell
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub 展开
- 你的回答被采纳后将获得：
- 系统奖励15（财富值+成长值）+难题奖励10（财富值+成长值）+提问者悬赏40（财富值+成长值）
2个回答
展开全部
语敬桐迟句Sheets("Sheet2").SelectActiveSheet.Range($A$1:$J$6).AutoFilter Field:=3,Criterial1:=_"=In Progress", Operator:=xlOr,Criteria2:="=Resolved"Columns("G:G").Select
修改为亮李
Sheets("Sheet2").SelectActiveSheet.Range($A$1:$J$6).AutoFilter Field:=3,Criterial1:=_"<>closed", Operator:=xlOr,Criteria2:="=Resolved"Columns("轮凳G:G").Select
修改为亮李
Sheets("Sheet2").SelectActiveSheet.Range($A$1:$J$6).AutoFilter Field:=3,Criterial1:=_"<>closed", Operator:=xlOr,Criteria2:="=Resolved"Columns("轮凳G:G").Select
更多追问追答
追问
在吗？
在吗？
本回答被网友采纳
已赞过
已踩过<
评论
收起
你对这个回答的评价是？
推荐律师服务：
若未解决您的问题，请您详细描述您的问题，通过百度律临进行免费专业咨询
