2
次のVBAコードを使用して、ワークブックから範囲をコピーして電子メールに貼り付けます。vbaはブックからペーストして電子メールに貼り付けますか？
これは問題を引き起こすコードです。エラー438この行の「オブジェクトは、このプロパティまたはメソッドをサポートしていません」：
WB3.Range("A20:J30").SpecialCells (xlCellTypeVisible)
コード：私ははThisWorkbookを使用している場合
'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))
を、正常に動作するようです。私は他のワークブックをどのように定義しているか、何か問題があります。私が間違っているつもりですどこの誰かは私を見ることができます
G:\BUYING\Food Specials\2. Planning\3. Confirmation and Delivery\Announcements\2017\test\Accrol.xlsx
嘆願：列Fで
私の細胞がすべてのような有効なパスが含まれていますか？理想的には、私はむしろそれを開くことなく、ワークブックからの範囲を得るだろうが、うーん、私は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:[email protected]>")
Call doc.ReplaceItemValue("ReplyTo", "[email protected]")
Call doc.ReplaceItemValue("DisplaySent", "[email protected]")
'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
エラーを返す行はどれですか？それは 'Set WB3 = Workbooks.Open（Range（" F "＆i）.value）'ですか？その場合は、期待される名前のブックが存在することを確認しましたか？ –
@ destination-data更新された質問を参照してください – user7415328
'WB3.Sheets（1）.Range' – Slai