Excel vba从工作簿复制范围并粘贴到电子邮件？_Excel_Vba

Excel vba从工作簿复制范围并粘贴到电子邮件？

excel vba

Excel vba从工作簿复制范围并粘贴到电子邮件？,excel,vba,Excel,Vba,我正在使用以下VBA代码尝试从工作簿复制一个范围，并将其粘贴到电子邮件中：这是导致问题的代码段。此行出现错误438“对象不支持此属性或方法”： WB3.Range("A20:J30").SpecialCells (xlCellTypeVisible) 代码：如果我用这个练习册，看起来效果不错。我定义其他工作簿的方式有问题 F列中的“我的单元格”都包含以下有效路径： G:\BUYING\Food Specials\2. Planning\3. Confirmation and Deliver

我正在使用以下VBA代码尝试从工作簿复制一个范围，并将其粘贴到电子邮件中：

这是导致问题的代码段。此行出现错误438“对象不支持此属性或方法”：

WB3.Range("A20:J30").SpecialCells (xlCellTypeVisible)

代码：

如果我用这个练习册，看起来效果不错。我定义其他工作簿的方式有问题

F列中的“我的单元格”都包含以下有效路径：

G:\BUYING\Food Specials\2. Planning\3. Confirmation and Delivery\Announcements\2017\test\Accrol.xlsx

请问有人能告诉我哪里出了问题吗？理想情况下，我宁愿从工作簿中获取范围而不必打开它，但唉，我是vba的新手，所以不确定这是否可行

目的是将范围放入电子邮件正文中

Call stream.WriteText(rangetoHTML(rng))

完整代码：

Sub Send()
Dim answer As Integer
    answer = MsgBox("Are you sure you want to Send All Announcements?", vbYesNo + vbQuestion, "Notice")
    If answer = vbNo Then
    Exit Sub

    Else

Application.DisplayAlerts = False
Application.ScreenUpdating = False

Dim Attachment As String
Dim WB3 As Workbook
Dim WB4 As Workbook
Dim rng As Range
Dim db As Object
Dim doc As Object
Dim body As Object
Dim header As Object
Dim stream As Object
Dim session As Object
Dim i As Long
Dim j As Long
Dim server, mailfile, user, usersig As String
Dim LastRow As Long, ws As Worksheet
LastRow = Worksheets(1).Range("F" & Rows.Count).End(xlUp).Row  'Finds the last used row

j = 18

With ThisWorkbook.Worksheets(1)

For i = 18 To LastRow


'Start a session of Lotus Notes
Set session = CreateObject("Notes.NotesSession")
'This line prompts for password of current ID noted in Notes.INI
Set db = session.CurrentDatabase
Set stream = session.CreateStream
' Turn off auto conversion to rtf
session.ConvertMime = False



'Email Code

'Create email to be sent

Set doc = db.CreateDocument
doc.Form = "Memo"
Set body = doc.CreateMIMEEntity
Set header = body.CreateHeader("Promotion Announcement for week " & Range("I8").value & ", " & Range("T8").value & " - Confirmation required")
Call header.SetHeaderVal("HTML message")

'Set From
Call doc.ReplaceItemValue("Principal", "Food Specials <mailto:Food.Specials@Lidl.co.uk>")
Call doc.ReplaceItemValue("ReplyTo", "Food.Specials@Lidl.co.uk")
Call doc.ReplaceItemValue("DisplaySent", "Food.Specials@Lidl.co.uk")

'To
Set header = body.CreateHeader("To")
Call header.SetHeaderVal(Range("Q" & i).value)


'Email Body
Call stream.WriteText("<HTML>")
Call stream.WriteText("<font size=""3"" color=""black"" face=""Arial"">")
Call stream.WriteText("<p>Good " & Range("A1").value & ",</p>")
Call stream.WriteText("<p>Please see attached an announcement of the spot buy promotion for week " & Range("I8").value & ", " & Range("T8").value & ".<br>Please check, sign and send this back to us within 24 hours in confirmation of this order. Please also inform us of when we can expect the samples.</p>")
Call stream.WriteText("<p>The details are as follows:</p>")

'Insert Range
Dim app As New Excel.Application
app.Visible = False
'open a workbook that has same name as the sheet name
Set WB3 = Workbooks.Open(Range("F" & i).value)
'select cell A1 on the target book
WB3.Range("A20:J30").SpecialCells (xlCellTypeVisible)

Call stream.WriteText(rangetoHTML(rng))


Call stream.WriteText("<p><b>N.B.  A volume break down by RDC will follow 4/5 weeks prior to the promotion. Please note that this is your responsibility to ensure that the orders you receive from the individual depots match the allocation.</b></p>")
Call stream.WriteText("<p>We also need a completed Product Technical Data Sheet. Please complete this sheet and attach the completed sheet in your response.</p>")

'Attach file
Attachment = Range("F" & i).value
Set AttachME = doc.CREATERICHTEXTITEM("attachment")
Set EmbedObj = AttachME.EmbedObject(1454, "", Attachment, "")


Call stream.WriteText("<BR><p>Please note the shelf life on delivery should be 75% of the shelf life on production.</p></br>")
'Signature
Call stream.WriteText("<BR><p>Kind regards / Mit freundlichen Grüßen,</p></br>")
Call stream.WriteText("<p><b>Lidl UK Food Specials Team</b></p>")

Call stream.WriteText("<table border=""0"">")
Call stream.WriteText("<tr>")
Call stream.WriteText("<td><img src=""http://www.lidl.co.uk/statics/lidl-uk/ds_img/layout/top_logo2016.jpg"" alt=""Mountain View""></td>")
Call stream.WriteText("<td><img src=""http://www.lidl.co.uk/statics/lidl-uk/ds_img/assets_x_x/BOQLOP_NEW%281%29.jpg"" alt=""Mountain View""></td>")
Call stream.WriteText("</tr>")
Call stream.WriteText("</table>")


Call stream.WriteText("</font>")
Call stream.WriteText("</body>")
Call stream.WriteText("</html>")

Call body.SetContentFromText(stream, "text/HTML;charset=UTF-8", ENC_IDENTITY_7BIT)

Call doc.Send(False)
session.ConvertMime = True ' Restore conversion - very important


'Clean Up the Object variables - Recover memory
    Set db = Nothing
    Set session = Nothing
    Set stream = Nothing
    Set doc = Nothing
    Set body = Nothing
    Set header = Nothing

    WB3.Close savechanges:=False

    Application.CutCopyMode = False

'Email Code

j = j + 1

Next i
End With


Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "Success!" & vbNewLine & "Announcements have been sent."

End If
End Sub

Sub-Send（）
将答案设置为整数
answer=MsgBox（“您确定要发送所有通知吗？”，vbYesNo+vbQuestion，“通知”）
如果答案=vbNo，则
出口接头
其他的
Application.DisplayAlerts=False
Application.ScreenUpdating=False
作为字符串的Dim附件
将WB3设置为工作簿
将WB4设置为工作簿
变暗rng As范围
作为对象的Dim db
Dim doc作为对象
以暗体为对象
作为对象的标题变暗
作为对象的暗流
将会话设置为对象
我想我会坚持多久
Dim j尽可能长
Dim服务器、邮件文件、用户、usersig作为字符串
将最后一行调整为长，ws为工作表
LastRow=工作表（1）。范围（“F”和Rows.Count）。结束（xlUp）。行“查找最后使用的行
j=18
使用此工作簿。工作表（1）
从i=18到最后一行
'启动Lotus Notes会话
Set session=CreateObject（“Notes.NotesSession”）
'此行提示输入Notes.INI中记录的当前ID的密码
Set db=session.CurrentDatabase
Set stream=session.CreateStream
'关闭到rtf的自动转换
session.ConvertMime=False
'电子邮件代码
'创建要发送的电子邮件
Set doc=db.CreateDocument
doc.Form=“备忘录”
设置正文=doc.CreateMIMEEntity
Set header=body.CreateHeader（“本周促销公告”和范围（“I8”）.value&“，”和范围（“T8”）.value&“需要确认”）
调用header.SetHeaderVal（“HTML消息”）
“从
调用文件ReplaceItemValue（“委托人”、“食品特价”）
调用doc.ReplaceItemValue（“ReplyTo”，“Food”。Specials@Lidl.co.uk")
调用doc.ReplaceItemValue（“displayssent”，“Food”。Specials@Lidl.co.uk")
”“对
Set header=body.CreateHeader（“To”）
调用header.SetHeaderVal（范围（“Q”&i）.value）
'邮件正文
调用stream.WriteText（“”）
调用stream.WriteText（“”）
调用stream.WriteText（“Good”和Range（“A1”）.value&”，”）
Call stream.WriteText（请参阅随附的本周现货购买促销公告“&Range（“I8”）.value&“，”&Range（“T8”）.value&“
请检查、签名并在24小时内发送给我们，以确认此订单。还请告知我们何时可以收到样品。）
调用stream.WriteText（“详细信息如下：”）
'插入范围
Dim应用程序作为新的Excel.Application
app.Visible=False
'打开与工作表名称同名的工作簿
设置WB3=工作簿.Open（范围（“F”&i）.value）
'选择目标书本上的单元格A1
WB3.范围（“A20:J30”）.特殊单元格（xlCellTypeVisible）
调用stream.WriteText（rangetoHTML（rng））
Call stream.WriteText（“N.B.RDC将在促销前的4/5周进行数量细分。请注意，您有责任确保从各个仓库收到的订单与分配相匹配。”）
调用stream.WriteText（“我们还需要一份完整的产品技术数据表。请填写此表，并在回复中附上完整的表。”）
'附加文件
附件=范围（“F”和i）.值
Set AttachME=doc.CREATERICHTEXTITEM（“附件”）
设置EmbedObj=AttachME.EmbedObject（1454，“，Attachment，”）
调用stream.WriteText（“
请注意，交付时的保质期应为生产时保质期的75%。

”）
“签名
调用stream.WriteText（“
亲切问候/Mit freundlichen Grün，

”）
调用stream.WriteText（“Lidl英国食品特价团队””）
调用stream.WriteText（“”）
调用stream.WriteText（“”）
调用stream.WriteText（“”）
调用stream.WriteText（“”）
调用stream.WriteText（“”）
调用stream.WriteText（“”）
调用stream.WriteText（“”）
调用stream.WriteText（“”）
调用stream.WriteText（“”）
调用body.SetContentFromText（流，“text/HTML；charset=UTF-8”，ENC_IDENTITY_7BIT）
调用doc.Send（False）
session.ConvertMime=True“还原转换-非常重要
'清除对象变量-恢复内存
Set db=Nothing
设置会话=无
设置流=无
设置文档=无
集合体=无
设置标题=无
WB3.关闭保存更改：=False
Application.CutCopyMode=False
'电子邮件代码
j=j+1
接下来我
以
Application.DisplayAlerts=True
Application.ScreenUpdating=True
MsgBox“Success！”&vbNewLine&“通知已发送。”
如果结束
端接头

WB3是工作簿对象。工作簿不支持。取而代之的是，使用一个

范例

WB3.Sheets(1).Range("A20:J30").SpecialCells(xlCellTypeVisible)

这条线本身没有任何作用。如果要选择这些单元格，请调用select方法：

WB3.Sheets(1).Range("A20:J30").SpecialCells(xlCellTypeVisible).Select

编辑

刚刚注意到@Slai已经在注释中确定了根本原因。

哪一行返回错误？是否设置WB3=Workbooks.Open（范围（“F”&i）.value）？如果是这样的话，您是否已验证存在具有预期名称的工作簿？@目标数据请参阅更新的问题

WB3.Sheets（1）.Range

@Slai为什么不将您的评论作为答案发布？@Ralph在我的手机上，这更像是对答案的提示。一个好的答案需要解释并阅读整个问题，而我还没有喝足够的咖啡：]如果您使用其他用户的评论作为答案，那么您应该将此答案标记为“我的评论不是答案”。我希望有人会提到，如果有多张工作表，使用工作表名称而不是数字。似乎它应该是

Set rng=WB3.Sheets（“Sheet1”）.Range…

，因为它下面有一行

WB3.Sheets(1).Range("A20:J30").SpecialCells(xlCellTypeVisible).Select