送信前にIBM Notes電子メールをPDFとして印刷/保存しますか？

私は以下のコードを使用して、IBM Notesを使用してExcelから電子メールを作成して送信しています。送信前にIBM Notes電子メールをPDFとして印刷/保存しますか？

私はこの電子メールをPDFとしてフォルダに保存するか、単に印刷してPDFとして印刷できるようにしようとしました。

私は何をしようとしても、これを印刷/ PDFとして保存することはできません。残りのコードは正常に動作しています。

このコードを使用すると、作成された各メールの添付ファイルが保存されます。

Attachment = Range("F" & i).value 
Set AttachME = doc.CREATERICHTEXTITEM("attachment") 
Set EmbedObj = AttachME.EmbedObject(1454, "", Attachment, "") 
EmbedObj .ExtractFile "C:\attach\" & EmbedObj .Name

は、私もこれを変更しようとした：

Set doc = db.CreateDocument 
doc.ExtractFile "C:\attach\" & "SomeFileName.pdf"

しかし、これは生産悲しいかなオブジェクトは、このプロパティまたはメソッドエラーをサポートしていません。私もこれを試しています：

doc.Print True, False

まだ運がありません。

私の完全なコード：

Sub Send() 
ActiveSheet.DisplayPageBreaks = False 
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 j2 As Long 
Dim server, mailfile, user, usersig As String 
Dim LastRow As Long, LastRow2 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]") 

Call doc.ReplaceItemValue("Subject", "Promotion Announcement for week " & Range("I8").value & ", " & Range("T8").value & " - Confirmation required") 

'To 
Set header = body.CreateHeader("To") 
Call header.SetHeaderVal(Range("N" & 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 
Set WB3 = Workbooks.Open(Range("F" & i).value) 
With WB3.Sheets(1) 
.Range("A20:J39").SpecialCells(xlCellTypeVisible).Select 
Set Rng = Selection 
End With 

Call stream.WriteText(RangetoHTML(Rng)) 
WB3.Close SaveChanges:=False 


'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&#252;&#223;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) 

doc.Print True, False 

doc.Save True, False 
Call doc.PutInFolder("TEST") 

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." 
MsgBox doc.GetItemValue("subject")(0) 

End If 
End Sub 




Function RangetoHTML(Rng As Range) 
' Changed by Ron de Bruin 28-Oct-2006 
' Working in Office 2000-2010 
    Dim fso As Object 
    Dim ts As Object 
    Dim TempFile As String 
    Dim TempWB As Workbook 

    TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm" 

    'Copy the range and create a new workbook to past the data in 
    Rng.Copy 
    Set TempWB = Workbooks.Add(1) 
    With TempWB.Sheets(1) 
     .Cells(1).PasteSpecial Paste:=8 
     .Cells(1).PasteSpecial xlPasteValues, , False, False 
     .Cells(1).PasteSpecial xlPasteFormats, , False, False 
     .Cells(1).Select 
     Application.CutCopyMode = False 
     On Error Resume Next 
     .DrawingObjects.Visible = True 
     .DrawingObjects.Delete 
     On Error GoTo 0 
    End With 

    'Publish the sheet to a htm file 
    With TempWB.PublishObjects.Add(_ 
     SourceType:=xlSourceRange, _ 
     fileName:=TempFile, _ 
     Sheet:=TempWB.Sheets(1).name, _ 
     Source:=TempWB.Sheets(1).UsedRange.Address, _ 
     HtmlType:=xlHtmlStatic) 
     .Publish (True) 
    End With 

    'Read all data from the htm file into RangetoHTML 
    Set fso = CreateObject("Scripting.FileSystemObject") 
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2) 
    RangetoHTML = ts.ReadAll 
    ts.Close 
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _ 
          "align=left x:publishsource=") 

    'Close TempWB 
    TempWB.Close SaveChanges:=False 

    'Delete the htm file we used in this function 
    Kill TempFile 

    Set ts = Nothing 
    Set fso = Nothing 
    Set TempWB = Nothing 
End Function

誰かが私が間違っているつもりですどこ私を見ることができますしてください？

出典

2017-03-21 user7415328

Notes APIには、メッセージをPDFとして保存する機能はありません。

EmbedObjectに範囲を渡すことはできません。 EmbedObjectは既にディスクに保存したファイルのファイル名を要求します。 EmbedObjectを使用してPDFを作成し、電子メールに添付することができます。誰かがすでにPDFを作成して電子メールに添付している場合、ExtractFileを使ってPDFをディスクに保存することができます。これは、NotesDocumentクラスではなく、NotesRichTextItemクラスのメソッドです。最後に、NotesDocumentクラスにはprintメソッドもありません。

私の知る限り、Notes電子メールメッセージをPDFファイルとして保存する唯一のソリューションは、サードパーティの商用ソフトウェアが必要です。（PDF関連のオープンソースプロジェクトはOpenNTFのウェブサイトにいくつかありますが、それらはすべてVBAからアクセスできないLotus XPagesテクノロジーに基づいていると思います）

出典

2017-03-21 21:02:55

送信前にIBM Notes電子メールをPDFとして印刷/保存しますか？

答えて

関連する問題