New Response

« Return to the main article

You are replying to:

  1. Hello Here !

    The problem I had was that I could not even touch to the domino server ( not even look at it , must be precious), therefore i was stuck ,when suddenly ... ... I decided to use the good old clipboard object to make my deal. It means that this is(again) a window only solution ( even if i think that the problem can be solved thisd way in with any OS)

    Pasting HTML into lotus limitations:

    I still must warn you to be very careful with your spanning, as the lotus browser is a bitch. Be also careful with nested tables as the browser will produce a huge linejump between your 2 nested tables. Other problem is the table border. Well, you've got the border, but i did not find a way to make it other thant standard white. Regarding embeding graphx , no sé yet ( if you have acces to the server or can get a long term lasting ftp directory, I would advice you to make a src pointing to your image, it works well. Lotus accepts Css , but doesn't seem to like Css for tables.

    Anyway, here is the way code (VB/lostusScript):

    First . add a reference to the LotusDominoObject library

    Then the following code is the code you need to send an email


    'declare your mail object Public newLotusMail As New cLotusMailClient.cLotusMail

    Private Sub LotusMailing()

    Call newLotusMail.Initialize(YourPassword, YourNotesDatabase, DominoServer)

    If newLotusMail.SendHtml(YourHTMLString,To,Subject,[CC],[Bcc]) = True Then

    msgBox"YooHoo,Your email has been sent. Have a break and go to your favourite record dealer and maybe get the last godspeed in vynil" ' just to verify it went ok

    end if

    End Sub -------------------------------------------------------------------------------- ------------

    '------------------------------------------- ' 2002 Ben Levy - Long life to Open source ! '-------------------------------------------

    Put the following code on a class called 'cLotusMailClient' Or do whatever you want with it

    Option Explicit

    Private pstrPassword As String Private pstrServer As String Private pstrMailDb As String

    Private oLotusSession As Object Private oLotusWorkspace As Object Private oLotusUIDoc As Object

    Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long Private Declare Function RegisterClipboardFormat Lib "user32" Alias _ "RegisterClipboardFormatA" (ByVal lpString As String) As Long Private Declare Function EmptyClipboard Lib "user32" () As Long Private Declare Function CloseClipboard Lib "user32" () As Long Private Declare Function SetClipboardData Lib "user32" ( _ ByVal wFormat As Long, ByVal hMem As Long) As Long Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, _ ByVal dwBytes As Long) As Long Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _ ByVal Destination As Long, Source As Any, ByVal Length As Long) Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long Private Declare Function GlobalFree Lib "kernel32" ( _ ByVal hMem As Long) As Long

    Private Const GMEM_DDESHARE = &H2000 Private Const GMEM_MOVEABLE = &H2

    ________________________________________________________________________________ _____________

    '------------------------------------------- ' Gets the properties required to connect ' Session and database '------------------------------------------- Public Sub Initialize(ByRef strpassword As String, _ ByRef strMailDb As String, _ Optional ByRef strServer As String)

    On Error GoTo err:

    pstrPassword = strpassword pstrServer = strServer pstrMailDb = strMailDb

    If oLotusSession Is Nothing Then Set oLotusSession = CreateObject("Lotus.NotesSession") Call oLotusSession.Initialize(pstrPassword) Set oLotusWorkspace = CreateObject("Notes.NotesUIWorkspace") End If

    Exit Sub

    err: MsgBox "Problem in the InitializeDomino, Session not Initialized", vbCritical + vbOKOnly, "ERROR" End Sub

    ________________________________________________________________________________ ____________________

    '--------------------------- ' sends an html based email '--------------------------- Public Function SendHtml(ByVal strHTML As String, _ ByVal strTo As String, _ ByVal strSubject As String, _ Optional ByVal strCc As String, _ Optional ByVal strBcc As String) As Boolean

    strHTML = ClipboardFormatHTML(strHTML) PasteToClipboard (strHTML) SendHtml = SendMail(strTo, strSubject, True, , strCc, strBcc)

    End Function

    ________________________________________________________________________________ _________

    ' ---------------------------------------- ' Builds HTML Clipboard Header ' In order to be able to copy ' HTML to clipboard ' ---------------------------------------- Private Function ClipboardFormatHTML(ByVal strHTML As String) As String

    Dim strHeader As String ' Temp Header String Dim strRealHeader As String ' Final Header String Dim strBuildXmlTemp As String ' Temp Header String + Former HTML string

    strHeader = "Version:1.0" & vbCrLf strHeader = strHeader & "StartHTML:" & InStr(1, strHTML, "<HTML") & "00" & vbCrLf strHeader = strHeader & "EndHTML:" & Len(strHTML) - 4 & vbCrLf strHeader = strHeader & "StartFragment:" & InStr(1, strHTML, "<BODY>") + 8 & "00" & vbCrLf strHeader = strHeader & "EndFragment:" & Len(strHTML) - 36 & vbCrLf strHeader = strHeader & "<!DOCTYPE HTML PUBLIC '-//W3C//DTD HTML 4.0 Transitional//EN'>" & vbCrLf strBuildXmlTemp = strHeader & strHTML

    strRealHeader = "Version:1.0" & vbCrLf strRealHeader = strRealHeader & "StartHTML: 000 " & vbCrLf strRealHeader = strRealHeader & "EndHTML:" & Len(strBuildXmlTemp) - 4 & vbCrLf strRealHeader = strRealHeader & "StartFragment:" & InStr(1, strBuildXmlTemp, "<BODY>") + 8 & vbCrLf strRealHeader = strRealHeader & "EndFragment:" & Len(strBuildXmlTemp) - 36 & vbCrLf strRealHeader = strRealHeader & "<!DOCTYPE HTML PUBLIC '-//W3C//DTD HTML 4.0 Transitional//EN'>" & vbCrLf ClipboardFormatHTML = strRealHeader & strHTML

    End Function

    ________________________________________________________________________________ _________

    '------------------------------ ' Routine to Copy the HTML ' string to the clipboard '------------------------------ Private Sub PasteToClipboard(ByVal pstrHtmlString As String)

    Dim lngSuccess As Long Dim lngHTML As Long Dim lngGlobal As Long Dim lngpString As Long

    lngSuccess = OpenClipboard(frmMain2.hwnd) lngHTML = RegisterClipboardFormat("HTML format") lngSuccess = EmptyClipboard lngGlobal = GlobalAlloc(GMEM_MOVEABLE Or GMEM_DDESHARE, Len(pstrHtmlString)) lngpString = GlobalLock(lngGlobal) CopyMemory lngpString, ByVal pstrHtmlString, Len(pstrHtmlString) GlobalUnlock lngGlobal SetClipboardData lngHTML, lngGlobal CloseClipboard GlobalFree lngGlobal

    End Sub

    ________________________________________________________________________________ ____________

    '------------------------------------------ ' Creates a new memo from scratch ' saves it in the database ' sends the memo '------------------------------------------ Private Function SendMail(ByVal strTo As String, _ ByVal strSubject As String, _ ByVal booPaste As Boolean, _ Optional strBody As String, _ Optional ByVal strCc As String, _ Optional ByVal strBcc As String) As Boolean

    On Error GoTo err

    If oLotusUIDoc Is Nothing Then Set oLotusUIDoc = oLotusWorkspace.COMPOSEDOCUMENT(pstrServer, pstrMailDb, "Memo") End If

    Set oLotusUIDoc = oLotusWorkspace.CURRENTDOCUMENT

    'fill madatory mail fields Call oLotusUIDoc.FIELDSETTEXT("EnterSendTo", strTo) Call oLotusUIDoc.FIELDSETTEXT("Subject", strSubject)

    'Call oLotusUIDoc.CreateObject("bob", "HTML", "c:\test.html")

    'fill optional mail fields If strCc <> "" Then Call oLotusUIDoc.FIELDSETTEXT("EnterCopyTo", strCc) End If If strBcc <> "" Then Call oLotusUIDoc.FIELDSETTEXT("EnterBlindCopyTo", strBcc) End If

    If strBody <> "" Then ' fill the body if not html email Call oLotusUIDoc.FIELDSETTEXT("Body", strBody) ElseIf booPaste = True Then 'paste html to body Call oLotusUIDoc.GOTOFIELD("Body") Call oLotusUIDoc.Paste End If

    'send email and close

    Call oLotusUIDoc.Send Call oLotusUIDoc.Close

    SendMail = True

    Set oLotusUIDoc = Nothing

    Exit Function


    SendMail = False MsgBox "Problem in the SendMail Function, Email not sent", vbCritical + vbOKOnly, "ERROR"

    End Function ________________________________________________________________________________ _________

    That's all for now. if you have anyQuestion, well you can mail me at mrbrl@hotmail.com

Your Comments