PDA

View Full Version : Sleeper: Changing notes to outlook



Dale
07-13-2004, 08:34 AM
First off I want to thank all the people that have helped me in the past..;)

I need to convert a Lotus Notes script to Outlook 2000. And retain all the functionality.Here is the script..


Sub Send_Status_Update()
Declare Variables for file and macro setup
Dim UserName As String
Dim MailDbName As String
Dim Maildb As Object
Dim MailDoc As Object
Dim AttachME As Object
Dim Session As Object
Dim EmbedObj1 As Object
Dim Subject As String
Dim Recipient As String
Dim Response As String
Dim cell As Range
Dim FirstName As String
Dim ClubStatus As String
Response = MsgBox("This will generate an e-mail for the Volunteer List" _
& vbCrLf & " Do you wish to send the e-mail?" _
, vbYesNo + vbQuestion, "E-Mail Generation")
If Response = vbNo Then Exit Sub
'Open and locate current LOTUS NOTES User
Set Session = CreateObject("Notes.NotesSession")
UserName = Session.UserName
MailDbName = Left$(UserName, 1) & _
Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
Set Maildb = Session.GETDATABASE("", MailDbName)
If Maildb.IsOpen = True Then
Else
Maildb.OPENMAIL
End If
' Create New Mail and Address Title Handlers
Set MailDoc = Maildb.CreateDocument
' Set the Message Type
MailDoc.Form = "Memo"
' Declare a Message Subject
MailDoc.Subject = "Volunteer Status Update"
MailDoc.SendTo = Recipient
' Declare the message
' Determine E-Mail Address Range
For Each cell In Sheets("Master").Columns("A").Cells.SpecialCells(xlCellTypeConstants)
If cell.Offset(0, 4).Value <> "" Then
If cell.Offset(0, 4).Value Like "*@*" Then
' Determine Club Status
If cell.Offset(0, 7) > 25 Then
ClubStatus = "Congratulations on achieving Copper Club Status!"
ElseIf cell.Offset(0, 7) >= 17 And cell.Offset(0, 7) <= 20 Then
ClubStatus = "Congratulations on achieving Gold Club Status!"
ElseIf cell.Offset(0, 7) >= 9 And cell.Offset(0, 7) <= 16 Then
ClubStatus = "Congratulations on achieving Silver Club Status!"
ElseIf cell.Offset(0, 7) < 9 And cell.Offset(0, 7) > 0 Then
ClubStatus = "Congratulations on achieving Bronze Club status!" _
& vbNewLine & vbNewLine & _
"You need " & 9 - cell.Offset(0, 7).Value & " more hour(s) to achieve " _
& "Silver Club Status!"
End If
' Name and Message Body
FirstName = Right$(cell, (Len(cell) - InStr(1, cell, ",")))
Recipient = cell.Offset(0, 4).Value
' Indicate the following:
' Base Hours
' Friends & Family Hours
' Total Hours
' Bucks Earned
' Bucks Spent
' Account Balance
' Volunteer Club Status
MailDoc.Body = "Dear" & FirstName & "," _
& vbNewLine & vbNewLine & _
"You have volunteered for " & cell.Offset(0, 5).Value & " Hours this year." _
& vbNewLine & vbNewLine & _
"Your Friends and Family have volunteered for " & cell.Offset(0, 6).Value & " Hours this year." _
& vbNewLine & vbNewLine & _
"You have a total of " & cell.Offset(0, 7).Value & " Volunteer Hours this year." _
& vbNewLine & vbNewLine & _
"You have earned $" & cell.Offset(0, 8).Value & " PennySaver Bucks this year." _
& vbNewLine & vbNewLine & _
"You have spent $" & cell.Offset(0, 9).Value & " PennySaver Bucks this year." _
& vbNewLine & vbNewLine & _
"You have a balance of $" & cell.Offset(0, 10).Value & " PennySaver Bucks in your account." _
& vbNewLine & vbNewLine & ClubStatus _
& vbNewLine & vbNewLine & vbNewLine & vbNewLine & _
"This is an automated e-mail from the Volunteer Management System..." _
& vbNewLine & "Please do not respond."
' Send Mail
MailDoc.PostedDate = Now()
On Error GoTo errorhandler1
MailDoc.SEND 0, Recipient
End If
End If
Next cell
Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set Session = Nothing
Set EmbedObj1 = Nothing
MsgBox "Your E-Mail has been sent", vbInformation + vbOKOnly, "Message Sent"
errorhandler1:
Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set Session = Nothing
Set EmbedObj1 = Nothing
With Application
.ScreenUpdating = True
.DisplayAlerts = True
End With
End Sub