Lotus VB script – email generator – add button

5 pts.
Tags:
Hotspots
Lotus hotspot
Lotus Notes 6.x
VBScript
Hi All, Ive got a vb sctipt (below), which will generate a load of emails in notes (v6.5) from an excel spreadsheet. Ive worked out how to do things like bold/red text, however i now want to add in a button hotspot, which, when clicked, will reply to my email i sent the user, with some text "xxxx". I know this is easy to do in notes using a hotspot button. but what would the vb code for this be? I want to add it in after ".AppendText "If your account is still being used, we appologise for any inc...." ----vb code--- Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" _ (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Sub GenerateEmail() ' 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, EMailSendTo, templateSubject, templateHeader, templateFooter, currRow, reportRow, reqRow Dim Sender, userGBID, userName, ManagerEmail, userEmail, foundPerm, endedPerm, tmpString, linesCnt, saveSendFlag Dim nonPermUsers, numNonPermUsers, reportSheetName, reportSheetRow, Count '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 templateSubject = dataSheet.Cells(5, 13).Value templateHeader = dataSheet.Cells(5, 14).Value templateFooter = dataSheet.Cells(5, 15).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 ManagerEmail = moversSheet.Cells(currRow, 5).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 & "," & vbCrLf & "- " ' 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 EmailCCTo = ManagerEmail ' 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) 'create 'cc' field Set objNotesField = objNotesDocument.AppendItemValue("CopyTo", EmailCCTo) ' 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 .AppendText "Dear " .AppendText userName .AppendText "," .AddNewLine (2) .AppendText "" objNotesStyle.Bold = True Call objNotesField.appendstyle(objNotesStyle) .AppendText userGBID objNotesStyle.Bold = False Call objNotesField.appendstyle(objNotesStyle) .AppendText " as one which is potentially not in use anymore and so should be removed." .AddNewLine (2) .AppendText "Using our historical records, we have found the following information about your ID " objNotesStyle.Bold = True Call objNotesField.appendstyle(objNotesStyle) .AppendText userGBID objNotesStyle.Bold = False Call objNotesField.appendstyle(objNotesStyle) .AppendText ":" .AddNewLine (2) .AppendText "********************************************************************" .AddNewLine (2) 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 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 End If reportRow = reportRow + 1 End If Wend With objNotesField .AddNewLine (1) .AppendText "********************************************************************" .AddNewLine (2) .AppendText "If your account is still being used, we appologise for any incovience caused by this email. To ensure that your account stays active and is NOT removed, you must relpy to this email stating why the above information is incorrect. This will allow our records to be updated" .AddNewLine (2) objNotesStyle.NotesColor = 4 objNotesStyle.Bold = True Call objNotesField.appendstyle(objNotesStyle) .AppendText "Please respond to this email by COB on Friday 9th May 2008." objNotesStyle.NotesColor = 0 objNotesStyle.Bold = False Call objNotesField.appendstyle(objNotesStyle)s .AddNewLine (1) End With ' Add footer tmpString = Replace(templateFooter, "<USERNAME>", userName) tmpString = Replace(tmpString, "<USERGBID>", userGBID) With objNotesField 'point 1 .AddNewLine (1) objNotesStyle.Bold = True Call objNotesField.appendstyle(objNotesStyle) .AppendText "- Monday 12th May 2008: " objNotesStyle.Bold = False Call objNotesField.appendstyle(objNotesStyle) .AppendText " *" objNotesStyle.Bold = True Call objNotesField.appendstyle(objNotesStyle) .AppendText userGBID objNotesStyle.Bold = False Call objNotesField.appendstyle(objNotesStyle) .AppendText "*" 'point 2 .AddNewLine (1) objNotesStyle.Bold = True Call objNotesField.appendstyle(objNotesStyle) .AppendText "- Wednesday 14th May 2008: " objNotesStyle.Bold = False Call objNotesField.appendstyle(objNotesStyle) .AppendText " s." 'point 3 .AddNewLine (1) objNotesStyle.Bold = True Call objNotesField.appendstyle(objNotesStyle) .AppendText "- Monday 26th May 2008: " objNotesStyle.Bold = False Call objNotesField.appendstyle(objNotesStyle) .AppendText " o." 'point 4 .AddNewLine (1) objNotesStyle.Bold = True Call objNotesField.appendstyle(objNotesStyle) .AppendText "- Monday 9th June 2008: " objNotesStyle.Bold = False Call objNotesField.appendstyle(objNotesStyle) .AppendText "Delete the windows logon account *" objNotesStyle.Bold = True Call objNotesField.appendstyle(objNotesStyle) .AppendText userGBID objNotesStyle.Bold = False Call objNotesField.appendstyle(objNotesStyle) .AppendText "*" .AddNewLine (1) '.AppendText tmpString End With With objNotesField .AddNewLine (1) .AppendText " " .AddNewLine (2) objNotesStyle.NotesColor = 2 objNotesStyle.Bold = True objNotesStyle.Italic = True Call objNotesField.appendstyle(objNotesStyle) .AppendText "text." .AddNewLine (1) objNotesStyle.NotesColor = 0 objNotesStyle.Bold = False objNotesStyle.Italic = False Call objNotesField.appendstyle(objNotesStyle) .AddNewLine (1) End With With objNotesField .AppendText "Kind Regards," .AddNewLine (2) objNotesStyle.Italic = True objNotesStyle.NotesColor = 14 Call objNotesField.appendstyle(objNotesStyle) .AppendText " " .AddNewLine (1) .AppendText " " .AddNewLine (1) .AppendText " " .AddNewLine (1) .AppendText " " .AddNewLine (1) .AppendText "Call: " .AddNewLine (1) .AppendText "Email: " .AddNewLine (1) .AppendText "website" .AddNewLine (1) 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 Set objNotesStyle = Nothing End If ' Next mover currRow = currRow + 1 Wend ' Hide the status dialog and delete it (remove reference to it) statusDialog.Hide MsgBox "The e-mail generator script has run sucessfully" & vbCrLf & _ "" & vbCrLf & _ "In total: " & vbCrLf & _ "Leavers processed = " & statusDialog.Label2.Caption & vbCrLf & _ "Leavers with no e-mail created = " & numNonPermUsers & vbCrLf & _ "Total e-mails created = " & (statusDialog.Label2.Caption - numNonPermUsers), vbExclamation, "Completed" ' 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
ASKED: May 8, 2008  11:06 AM
UPDATED: May 8, 2008  12:13 PM

Answer Wiki

Thanks. We'll let you know when a new response is added.
Send me notifications when members answer or reply to this question.

REGISTER or login:

Forgot Password?
By submitting you agree to receive email from TechTarget and its partners. If you reside outside of the United States, you consent to having your personal data transferred to and processed in the United States. Privacy

Discuss This Question:  

 
There was an error processing your information. Please try again later.
Thanks. We'll let you know when a new response is added.
Send me notifications when members answer or reply to this question.

REGISTER or login:

Forgot Password?
By submitting you agree to receive email from TechTarget and its partners. If you reside outside of the United States, you consent to having your personal data transferred to and processed in the United States. Privacy

Forgot Password

No problem! Submit your e-mail address below. We'll send you an e-mail containing your password.

Your password has been sent to:

To follow this tag...

There was an error processing your information. Please try again later.

REGISTER or login:

Forgot Password?
By submitting you agree to receive email from TechTarget and its partners. If you reside outside of the United States, you consent to having your personal data transferred to and processed in the United States. Privacy

Thanks! We'll email you when relevant content is added and updated.

Following