[英]How to call subroutine that references SpecialCells?
I built a script to create emails addressed to different people with individual attachments included.我构建了一个脚本来创建发送给不同人的电子邮件,其中包含单独的附件。 I have different subroutines that are called from this Mother Script.
我有从这个母脚本调用的不同子例程。
It works until the subroutine Distribution is called.在调用子程序 Distribution 之前它一直有效。 It stops at
它停在
For Each cell In sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants)
Sub Distribution()
'Working in Excel 2000-2016
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
Dim OutApp As Object
Dim OutMail As Object
Dim sh As Worksheet
Dim cell As Range
Dim FileCell As Range
Dim rng As Range
Dim StrBody As String
StrBody = "<BODY style=font-size:11pt;font-family:Arial>Hi team," & "<br><br>" & _
"Please find attached the most updated version of the Weekly Report. " & "<br>" & _
"If you have any doubt or comment, do not hesitate to reach out to us." & "<br><br>" & _
"Jorge Martinez"
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set sh = Sheets("Sheet1")
Set OutApp = CreateObject("Outlook.Application")
Windows("Free Trade Zone Weekly Reports.xlsm").Activate
For Each cell In sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants)
'Enter the path/file names in the C:Z column in each row
Set rng = sh.Cells(cell.Row, 1).Range("C1:Z1")
If cell.Value Like "?*@?*.?*" And _
Application.WorksheetFunction.CountA(rng) > 0 Then
Set OutMail = OutApp.CreateItem(0)
With OutMail
.to = cell.Value
.CC = "tulio.paz@diageo.com"
.Subject = "Weekly Report " & Date
Bodyformat = 2
'.Body = "<BODY style=font-size:11pt;font-family:Arial>Hi team," & "<br><br>" & _
"Please find attached the most updated version of the Weekly Report " & "<br>" & _
"If you have any doubt or comment, do not hesitate to reach out to us." & "<br><br>" & cell.Offset(0, -1).Value
.Importance = 2
.HTMLBody = StrBody & cell.Offset(0, -1).Value
For Each FileCell In rng.SpecialCells(xlCellTypeConstants)
If Trim(FileCell) <> "" Then
If Dir(FileCell.Value) <> "" Then
.Attachments.Add FileCell.Value
End If
End If
Next FileCell
.Display 'Or use .Display
End With
Set OutMail = Nothing
End If
Next cell
Set OutApp = Nothing
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub
I took it from Ron DeBruin's website.我是从 Ron DeBruin 的网站上拿来的。
The error is:错误是:
no data in selected cells.
所选单元格中没有数据。
If I stop the mother script and run this subroutine independently, it goes without any type of issue.如果我停止母脚本并独立运行此子例程,则不会出现任何问题。
I thought it would be fixed by activating the workbook that contains the script prior to that line, but no success.我认为可以通过激活包含该行之前的脚本的工作簿来修复它,但没有成功。
When working with SpecialCells
you have to be very careful.使用
SpecialCells
时必须非常小心。 Try this尝试这个
Replace代替
For Each cell In sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants)
with和
Dim rng As Range
On Error Resume Next
Set rng = sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants)
On Error GoTo 0
If rng Is Nothing Then
MsgBox "No Range with constants were found"
Exit Sub
End If
For Each cell In rng
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.