Senden Sie HTML-E-Mail über IBM Notes mit VBA?

Ich verwende den folgenden Code, um eine HTML-E-Mail über Excel und IBM Notes mit vba zu senden.Senden Sie HTML-E-Mail über IBM Notes mit VBA?

Hier My-Code ist:

Sub SendEmail() 

Application.DisplayAlerts = False 
Application.ScreenUpdating = False 


Application.CutCopyMode = False 


'Define Variables 
Dim Ref As String 
Dim TrueRef As String 

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 


'Define Depot 
Ref = Range("G" & (ActiveCell.Row)).Value 

    If Ref = "WED" Then 
    TrueRef = "WED" 
    Else 
    If Ref = "WSM" Then 
    TrueRef = "WES" 
    Else 
    If Ref = "NAY" Then 
    TrueRef = "NAY" 
    Else 
    If Ref = "ENF" Then 
    TrueRef = "ENF" 
    Else 
    If Ref = "LUT" Then 
    TrueRef = "MAG" 
    Else 
    If Ref = "NFL" Then 
    TrueRef = "NOR" 
    Else 
    If Ref = "RUN" Then 
    TrueRef = "RUN" 
    Else 
    If Ref = "SOU" Then 
    TrueRef = "SOU" 
    Else 
    If Ref = "SOU" Then 
    TrueRef = "SOU" 
    Else 
    If Ref = "BRI" Then 
    TrueRef = "BRI" 
    Else 
    If Ref = "LIV" Then 
    TrueRef = "LIV" 
    Else 
    If Ref = "BEL" Then 
    TrueRef = "BEL" 
    End If 
    End If 
    End If 
    End If 
    End If 
    End If 
    End If 
    End If 
    End If 
    End If 
    End If 
    End If 


'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("Food Specials Delivery Tracker: The Status of Your Issue Has Changed (" & Range("O" & ActiveCell.Row).Value & ")") 
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", "Food Specials Delivery Tracker: The Status of Your Issue Has Changed (" & Range("O" & ActiveCell.Row).Value & ")") 

'To 
Set header = body.CreateHeader("To") 
'Call header.SetHeaderVal("Supplychain-" & TrueRef & "@lidl.co.uk") 
Call header.SetHeaderVal("[email protected]") 


'Email Body 
Call stream.WriteText("<HTML>") 
Call stream.WriteText("<font size=""3"" color=""black"" face=""Arial"">") 
If Hour(Now) > 12 Then 
Call stream.WriteText("<p>Good afternoon,</p>") 
Else 
Call stream.WriteText("<p>Good morning,</p>") 
End If 
Call stream.WriteText("<p>Reference: " & Format(CDate(Range("A" & ActiveCell.Row).Value), "DDMMYY") & " - " & Range("C" & ActiveCell.Row).Value & " - " & Range("D" & ActiveCell.Row).Value & "</p>") 
If ThisWorkbook.Sheets(1).Range("O" & ActiveCell.Row).Value = "Issue Complete" Then 
Call stream.WriteText("<p>Your recent issue has been marked as complete.</p>") 
Else 
Call stream.WriteText("<p>The status of your recent issue has changed.</p>") 
End If 



'Insert Range 
ThisWorkbook.Sheets(1).Range("A" & ActiveCell.Row & ":L" & ActiveCell.Row & ", O" & ActiveCell.Row).SpecialCells(xlCellTypeVisible).Select 
Set Rng = Selection 
Call stream.WriteText(RangetoHTML(Rng)) 
Cells(1, 1).Select 

Call stream.WriteText("<BR><BR><p><a href=""G:\WH DISPO\(3) PROMOTIONS\(18) Food Specials Delivery Tracking\Food Specials Delivery Tracker.xlsm"">Click here to view your issue on the Delivery Tracker now.</a></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.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 






Application.DisplayAlerts = True 
Application.ScreenUpdating = True 





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

Wenn ich die E-Mail an mich senden, wird der HTML-Inhalt angezeigt.

Allerdings, wenn ich dies niemandem schicken - dies geschieht:

Bitte kann mir jemand zeigen, wo ich falsch gehe?

Quelle

2017-03-22 user7415328

Dieser Header ist das erste, was falsch ist:

Set header = body.CreateHeader("Food Specials Delivery Tracker: The Status of Your Issue Has Changed (" & Range("O" & ActiveCell.Row).Value & ")")

Header-Feldnamen keine Leerzeichen enthalten. Wenn die anderen E-Mail-Systeme das sehen, behandeln sie diese Zeile nicht als Kopfzeile. Sie beginnen, sie und alle Zeilen, die ihr folgen, als reine Textnachricht zu behandeln.

Ich habe nicht weiter nach Fehlern gesucht, so dass das möglicherweise nicht der einzige ist.

Quelle

2017-03-22 19:31:14

danke, ich werde es versuchen, aber wie erklärt dies die HTML-E-Mail gesendet wird gut in meine eigene E-Mail aber Text, wenn ich es an eine andere E-Mail senden? – user7415328

Da Sie die Nachricht in Notes erstellt haben und Notizen speichert diese Header als einzelne Elemente, nicht mit Textzeilen in einem einfachen Stream. Es weiß, dass diese Elemente Kopfzeilenelemente sind. Das erlaubt es, damit umzugehen, obwohl der Feldname technisch illegal ist. Zu dem Zeitpunkt, zu dem die Nachricht an ein anderes Mailsystem gelangt, wurde sie vom Domino-Router in einen Standard-RFC-822-Stream konvertiert. Bei der Konvertierung werden diese ungültigen Leerzeichen beibehalten, sodass das empfangende Mailsystem verwirrt wird. Es ist wahrscheinlich, dass Notes/Domino Ihre Nachricht als illegal abgelehnt haben sollte, aber nicht. –

das hat funktioniert, danke – user7415328

Dies ist das zweite Mal in nur ein paar Monaten habe ich diese Art von wirklich verschlungenen und kludgy If-Anweisung gesehen. Wird das in einer Region oder in einer bestimmten Ausbildung gelehrt?

Ich würde es umschreiben, um es einfacher zu lesen und zu pflegen. Es kann auf verschiedene Arten geschehen.

Bleiben Sie mit if-statments:

TrueRef = Ref 
If Ref = "WSM" Then 
    TrueRef = "WES" 
ElseIf Ref = "LUT" Then 
    TrueRef = "MAG" 
ElseIf Ref = "NFL" Then 
    TrueRef = "NOR" 
End If

Oder wie folgt aus:

If Ref = "WSM" Then 
    TrueRef = "WES" 
ElseIf Ref = "LUT" Then 
    TrueRef = "MAG" 
ElseIf Ref = "NFL" Then 
    TrueRef = "NOR" 
Else 
    TrueRef = Ref 
End If

Sie eine Select Case-Anweisung verwenden:

Select Case Ref 
    Case "WSM" 
     TrueRef = "WES" 
    Case "LUT" 
     TrueRef = "MAG" 
    Case "NFL" 
     TrueRef = "NOR" 
    Case Else 
     TrueRef = Ref 
End Select

Vergleichen Sie das mit Ihrem ursprünglichen Code :

If Ref = "WED" Then 
TrueRef = "WED" 
Else 
If Ref = "WSM" Then 
TrueRef = "WES" 
Else 
If Ref = "NAY" Then 
TrueRef = "NAY" 
Else 
If Ref = "ENF" Then 
TrueRef = "ENF" 
Else 
If Ref = "LUT" Then 
TrueRef = "MAG" 
Else 
If Ref = "NFL" Then 
TrueRef = "NOR" 
Else 
If Ref = "RUN" Then 
TrueRef = "RUN" 
Else 
If Ref = "SOU" Then 
TrueRef = "SOU" 
Else 
If Ref = "SOU" Then 
TrueRef = "SOU" 
Else 
If Ref = "BRI" Then 
TrueRef = "BRI" 
Else 
If Ref = "LIV" Then 
TrueRef = "LIV" 
Else 
If Ref = "BEL" Then 
TrueRef = "BEL" 
End If 
End If 
End If 
End If 
End If 
End If 
End If 
End If 
End If 
End If 
End If 
End If

Quelle

2017-03-27 18:24:01

Senden Sie HTML-E-Mail über IBM Notes mit VBA?

Antwort

Verwandte Themen