我有一本工作簿，其中包含不同客户的价目表，每周我必须通过电子邮件将所有价目表发送给相应的客户。这是一项非常耗时的任务，我一直在尝试使用VBA将其自动化。在大多数情况下，我已经通过使用Ron de Bruin的代码获得了成功，但是我遇到了一个似乎无法解决的问题，因此我希望能对我哪里出错了有所了解。
如前所述，该工作簿包含多个不同的价格表，所有这些价格表都需要发送给不同的客户。我已经稍微修改了this代码以满足我的需要（例如，仅处理可见的单元格，以包括电子邮件签名等）。我对该代码进行的一个主要更改是，我遍历了包含收件人地址的范围（如下所示）。
我当前面临的问题是该代码适用于除两张纸以外的所有纸。它将为这两个问题表创建一封电子邮件，但是范围（A1：L85）中的任何内容都不会粘贴到该电子邮件中-它只会发送一封电子邮件，除了我的签名外没有其他内容。使这更糟（或更有趣）的是，这两个问题表都出现在工作表的“中间”。假设问题单1 = PS_1，问题单2 = PS_2，就像这样：
WS_1，WS_2，...，WS_14，PS_1，WS_16，PS_2，WS_18，...，WS_32
所以我想知道为什么它只在这两张纸上弄乱了，以及如何解决它。
我已经在下面包括了我所有的代码（Ron de Bruin网站上的RangetoHTML除外，以及一个用于获取工作表名称的函数）：
Sub email()
' this is intended to speed up the code
With Excel.Application
.ScreenUpdating = False
.Calculation = Excel.xlCalculationManual
.EnableEvents = False
End With
Dim OutApp As Object
Dim OutMail As Object
Dim rng As Range 'this is the range of the price list
Dim erng As Range 'this is the range of email addresses
Dim cell As Range
Dim wsnames() As String 'worksheet names are stored in an array
Dim pricedate As String 'the week of prices the user provides (e.g. July 1st - July 7th)
Dim tsheets As Integer 'total sheets
'counting variables
Dim m As Integer
Dim n As Integer
Set OutApp = CreateObject("Outlook.Application")
'initializing variables
Set rng = Nothing
'initializing variables
n = 0
pricedate = InputBox("Enter the week the prices are for (e.g. July 10th - July 15th): ", "Week")
If pricedate = vbNullString Then Exit Sub 'if the user presses cancel it will stop the macro
tsheets = ActiveWorkbook.Worksheets.Count 'finds how many sheets are in the workbook to adjust the size of the array
ReDim wsnames(tsheets) 'resizes the size of the array
wsnames = storewsnames 'passing the sheet names to wsnames
For m = 1 To tsheets - 1
If wsnames(m) = "Atwood" Then Exit For 'looks for the index of worksheet "Atwood", and once it's found it exits the loop
Next m
For n = m To tsheets - 1 'sets n to the index of "Atwood"
If Sheets(wsnames(n)).Visible = True Then 'only will send emails to visible sheets
With Sheets(wsnames(n))
Set rng = .Range("A1:L85")
Set erng = .Range("M71:M85")
End With
On Error GoTo cleanup
For Each cell In erng 'searches the cells in the email addresses range
If cell.Value Like "?*@?*.?*" Then 'looks
'_for email addresses where the email addresses are saved
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.Display
.To = ""
.CC = ""
.BCC = cell.Value
.Subject = "CM Weekly Prices - " & wsnames(n)
.HTMLBody = "<BODY style=font-size:11pt;font-family:Calibri> Hi, " & _
"<br><br>" & "Below are the prices for the week of " & pricedate & _
"." & RangetoHTML(rng) & "Thank you, </BODY><br>" & .HTMLBody
.Send
End With
On Error GoTo cleanup
Set OutMail = Nothing
End If
Next cell
End If
Next n
' this is intended to speed up the code
With Excel.Application
.ScreenUpdating = True
.Calculation = Excel.xlCalculationAutomatic
.EnableEvents = True
End With
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub
我对使用VBA发送电子邮件非常陌生，因此我严重依赖于我使用的代码，并且尝试仅做些小改动。
如果您还有其他需要或不清楚的地方，请告诉我！