Lotus notes font style from VBA

jp1983

Board Regular
Joined
Apr 25, 2007
Messages
84
Hi,
got the following script which will generate a load of draft emails, from a list i have.
However i want some parts of the emails i create to be in bold (templateHeader for example)

anyone know how to do this?

Code:
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
      (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Sub MoversReports()

' Macro to mail out Movers reports for reviews by line managers

' Setup an error handler to report any errors during mail sending
'On Error GoTo SendMailError

' Setup key variables
Dim objNotesSession As Object
Dim NotesOpen As Long
Dim objNotesMailFile As Object
Dim objNotesDocument As Object
Dim objNotesStyle As Object
Dim objNotesField As Object
Dim dataSheet, reportSheet, moversSheet
Dim EMailCCTo, EMailBCCTo, EMailSendTo, templateSubject, templateHeader, templateFooter, templateAttach, currRow, reportRow, reqRow
Dim reportDate, sender, userGBID, userName, oldLineMgr, newLineMgr, userEmail, oldLineMgrEmail, newLineMgrEmail, transferDate, foundPerm, endedPerm, tmpString, linesCnt, saveSendFlag
Dim nonPermUsers, numNonPermUsers, reportSheetName, reportSheetRow

'Check if Lotus Notes is open or not.
NotesOpen = FindWindow("NOTES", vbNullString)

If NotesOpen = 0 Then
   MsgBox "Notes must be open to run this script!", vbExclamation
   Exit Sub
End If

' Note the worksheets we are using
Set dataSheet = ActiveWorkbook.Sheets("DATA")
Set reportSheet = ActiveWorkbook.Sheets("reason")
Set moversSheet = ActiveWorkbook.Sheets("leavers")

' Extract the send/save flag
saveSendFlag = ActiveWorkbook.Sheets("Instructions").Cells(5, 7).Value

' Extract the templates for the subject, header and footer, cc, bcc
'EMailBCCTo = ""
'EMailCCTo = dataSheet.Cells(5, 12).Value
templateSubject = dataSheet.Cells(5, 13).Value
templateHeader = dataSheet.Cells(5, 14).Value
templateFooter = dataSheet.Cells(5, 15).Value
templateAttach = dataSheet.Cells(5, 16).Value
sender = dataSheet.Cells(5, 17).Value

' Create a blank string to hold all the GBIDs of users who have no permissions within the list
nonPermUsers = ""
numNonPermUsers = 0

' Pop up the status dialog to notify user of progress
Dim statusDialog As UserForm1
Set statusDialog = New UserForm1

' Initialise the captions
statusDialog.Label2.Caption = "1"

' Make the form visible
statusDialog.Show

' Iterate through all user names in the movers list
currRow = 4

While moversSheet.Cells(currRow, 1).Value <> ""
  
    ' Update progress dialog
    statusDialog.Label2.Caption = CStr(currRow - 3)
    statusDialog.Repaint
    
    ' extract details from the movers row
    userGBID = UCase(Trim(moversSheet.Cells(currRow, 1).Value))
    userName = moversSheet.Cells(currRow, 2).Value & " " & moversSheet.Cells(currRow, 3).Value
        
    userEmail = moversSheet.Cells(currRow, 4).Value

    ' If any of the emails are blank, just replace with that users name
    If userEmail = "" Then userEmail = userName
            
    ' Iterate through all the permissions provided to check the user has any relevant permissions, as if not then nothing to send
    reqRow = 4
    
    ' Mult-page permission sheets coding
    reportSheetRow = 6
    reportSheetName = dataSheet.Cells(reportSheetRow, 18).Value
    Set reportSheet = ActiveWorkbook.Sheets(reportSheetName)

    foundPerm = False
    endedPerm = False
    While Not foundPerm And Not endedPerm
    
        ' Check if this is the end row for a sheet and if so, roll onto the next sheet
        If reportSheet.Cells(reqRow, 1).Value = "" Then
        
            reportSheetRow = reportSheetRow + 1
            reportSheetName = dataSheet.Cells(reportSheetRow, 18).Value
            
            If reportSheetName = "" Or reportSheetName = "END OF LIST" Then
                endedPerm = True
            Else
            
                ' Restart on next page
                Set reportSheet = ActiveWorkbook.Sheets(reportSheetName)
                reqRow = 4
                
            End If
        Else
        
            ' Note if find any permissions entries
          '  UCase (Trim(reportSheet.Cells(reqRow, 1).Select))
            If UCase(Trim(reportSheet.Cells(reqRow, 1).Value)) = userGBID Then
                foundPerm = True
            End If
        
            reqRow = reqRow + 1
        End If
    Wend
        
    ' If there are any permissions noted then connect to lotus and start building the email, else add to non perms list
    If foundPerm = False Then
    
        numNonPermUsers = numNonPermUsers + 1
    
        ' Add the user GBID into list for later display as no email will be sent
        If nonPermUsers = "" Then
            nonPermUsers = userGBID
        Else
            nonPermUsers = nonPermUsers & ","
            
            ' Add a new line on every 5th one to fill out the dialog box sensibly
            If numNonPermUsers Mod 5 = 0 Then
                nonPermUsers = nonPermUsers & Chr(10)
            End If
            nonPermUsers = nonPermUsers & userGBID
        End If
        
    Else
    
        ' Setup all the core email fields and header
        EMailSendTo = userEmail '' Required - Send to address
        
        ' Establish Connection to Notes
        Set objNotesSession = CreateObject("Notes.NotesSession")
        
        ' Establish Connection to Mail File
        Set objNotesMailFile = objNotesSession.GETDATABASE("", "")
        
        ' Open Mail
        objNotesMailFile.OPENMAIL
        
        ' Create New Memo
        Set objNotesDocument = objNotesMailFile.CREATEDOCUMENT
        
        ' Create 'Subject Field' - replace template fields with correct values
        tmpString = Replace(templateSubject, "<USERNAME>", userName)
        tmpString = Replace(tmpString, "<USERGBID>", userGBID)
        Set objNotesField = objNotesDocument.APPENDITEMVALUE("Subject", tmpString)
        
        ' Create 'Send To' Field
        Set objNotesField = objNotesDocument.APPENDITEMVALUE("SendTo", EMailSendTo)
        
       ' Note the sender as configured
        Set objNotesField = objNotesDocument.APPENDITEMVALUE("From", sender)
        objNotesDocument.Principal = sender
        
        ' Create 'Body' of memo
        Set objNotesField = objNotesDocument.CREATERICHTEXTITEM("Body")
        Set objNotesStyle = objNotesSession.CreateRichTextStyle
                      
        ' Add header
        tmpString = Replace(templateHeader, "<USERNAME>", userName)
        tmpString = Replace(tmpString, "<USERGBID>", userGBID)
        
        With objNotesField
            .appendtext tmpString
         End With
        
        ' Iterate through the permissions list report and generate lines for each permission
        reportRow = 4
        linesCnt = 0
        
        ' Mult-page permission sheets coding
        reportSheetRow = 6
        reportSheetName = dataSheet.Cells(reportSheetRow, 18).Value
        Set reportSheet = ActiveWorkbook.Sheets(reportSheetName)

        endedPerm = False
        
        While Not endedPerm
        
            ' Check if this is the end row for a sheet and if so, roll onto the next sheet
            If reportSheet.Cells(reportRow, 1).Value = "" Then
            
                reportSheetRow = reportSheetRow + 1
                reportSheetName = dataSheet.Cells(reportSheetRow, 18).Value
                
                If reportSheetName = "" Or reportSheetName = "END OF LIST" Then
                    endedPerm = True
                Else
                    ' Restart on next page
                    Set reportSheet = ActiveWorkbook.Sheets(reportSheetName)
                    reportRow = 4
                End If
    
            Else
        
                ' Where a match is found, add a line to the memo
                If UCase(Trim(reportSheet.Cells(reportRow, 1).Value)) = userGBID Then
                    
                    ' Increment count of retrievals listed
                    linesCnt = linesCnt + 1
                    
                    ' Build text for line - App name - (account id) (if not same as GBID) permissions
                    tmpString = reportSheet.Cells(reportRow, 2).Value

                    With objNotesField
                        .appendtext tmpString
                        .ADDNEWLINE 1
                        
                    End With
                
                End If
                
                reportRow = reportRow + 1
                
            End If
        Wend
                 
        ' Add footer
        tmpString = Replace(templateFooter, "<USERNAME>", userName)
        tmpString = Replace(tmpString, "<USERGBID>", userGBID)
        With objNotesField
            .appendtext tmpString
        End With
        
        ' Depending on what the flag is, either send or save to drafts
        If saveSendFlag = 1 Then
        
            ' Send the email & close down the connection with Lotus
            objNotesDocument.SaveMessageOnSend = True
            objNotesDocument.Send (0)
        
        Else
        
            ' Save the email as draft & close down the connection with Lotus
            Call objNotesDocument.Save(True, False)
            objNotesDocument.RemoveItem ("DeliveredDate")
            Call objNotesDocument.Save(True, False)
        
        End If
        
        ' Release storage
        Set objNotesSession = Nothing
        Set bjNotesSession = Nothing
        Set objNotesMailFile = Nothing
        Set objNotesDocument = Nothing
        Set objNotesField = Nothing
    
    End If
    
    ' Next mover
    currRow = currRow + 1

Wend

' Hide the status dialog and delete it (remove reference to it)
statusDialog.Hide

' After processed all the movers, notify the user if any movers had no permissions and no emails sent for them
If nonPermUsers <> "" Then

    
    Dim finalDialog As UserForm2
    Set finalDialog = New UserForm2
    
    ' Set the text on the form
    finalDialog.TextBox1.Text = nonPermUsers
    
    ' Make the form visible
    finalDialog.Show
    
End If

Exit Sub

' Error handling code designed to warn if any errors occurred during attempt to send email
SendMailError:
Msg = "Is Lotus Running? - Error # " & Str(Err.Number) & " was generated by " _
            & Err.Source & Chr(13) & Err.Description
MsgBox Msg, , "Error", Err.HelpFile, Err.HelpContext

End Sub
 

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).
ok, i worked out how to make the font bold/italic, by adding the following, however not sure abuot setting the colour to red?

Code:
                    'makes the font bold
                    objNotesStyle.Bold = True
                    objNotesStyle.NotesColor = COLOR_RED
                    Call objNotesField.AppendStyle(objNotesStyle)
                    
                    With objNotesField
                        .appendtext tmpString
                        .AddNewLine 1
                    End With
                    
                    'stops making font bold
                    objNotesStyle.Bold = False
                    Call objNotesField.AppendStyle(objNotesStyle)
 
Upvote 0
got it! rubbish notes using numbers and not words....

Code:
                    With objNotesField
                        objNotesStyle.Bold = True
                        objNotesStyle.NotesColor = 2
                        Call objNotesField.AppendStyle(objNotesStyle)
                                .appendtext tmpString
                                .AddNewLine 1
                        objNotesStyle.Bold = False
                        objNotesStyle.NotesColor = 0
                        Call objNotesField.AppendStyle(objNotesStyle)
                    End With
 
Upvote 0
thanks for that, i had just been guessing!

are you any good with vb/notes

from my script im trying to work out just how to make the userGBID bold & red, i can make entire sections go bold/red, however not bits within it.

i tried using a "with usergbid" but not sure what to use instead of appendtext, as i dont want to add it in, just change it.
 
Upvote 0
Hi all, sorry for reopening this older topic, but is there any reference on Lotus Notes classes at early binding, like what libraries to add, what methods, constants are available and how to use them properly?
 
Upvote 0

Forum statistics

Threads
1,213,489
Messages
6,113,947
Members
448,534
Latest member
benefuexx

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top