Problems with Excel and Lotus Notes interactivity

C

cdb

I helped design a spreadsheet that uses Excel to send an email via Lotus
Notes and for the actual emailing code I will freely admit that I just
borrowed it from someone else and don't understand it.

The spreadsheet is used by several users and seems to work fine in the main,
but one has encountered problems. This one user has the same operating system
(XP), the same Excel (2003) and the same Notes (6.5). The only difference is
that she is using a laptop, whereas I used a desktop to set up and test the
spreadsheet.

I've had her step through the code and the problem occurs on the line:
Set Session = CreateObject("Notes.NotesSession")

When it reaches this line, it skips to the error handling code at the
bottom. Without the error handler active I get the following erroer:

Run-Time error '429':
ActiveX component can't create object

Does anyone know of any reasons that this could be happening or any possible
solutions? Full code is below:

Code:
Sub emailer()

'Code to email RCR

With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With

TodaysDate = Date
ActiveWorkbook.SaveAs ("C:\Documents and Settings\" &
Environ("username") & "\My Documents\Recruitment Campaign Request " &
Sheets("Summary").Range("C10").Value & ", " &
Sheets("Summary").Range("C57").Value & " " & Left(TodaysDate, 2) & "-" &
Mid(TodaysDate, 4, 2) & "-" & Right(TodaysDate, 4) & ".xls")
savedworkbook = "C:\Documents and Settings\" & Environ("username") &
"\My Documents\Recruitment Campaign Request " &
Sheets("Summary").Range("C10").Value & ", " &
Sheets("Summary").Range("C57").Value & " " & Left(TodaysDate, 2) & "-" &
Mid(TodaysDate, 4, 2) & "-" & Right(TodaysDate, 4) & ".xls"
If ActiveWorkbook.Saved = False Then GoTo ExitSub
On Error GoTo ExitSub

user = Application.UserName
Mid(user, 1, 1) = UCase(Mid(user, 1, 1))
For counter = 1 To Len(user)
If Mid(user, counter, 1) = "." Then
Mid(user, counter, 1) = " "
Mid(user, counter + 1, 1) = UCase(Mid(user, counter + 1, 1))
End If
Next counter

' 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 'Attachment bit
Dim Session As Object
Dim EmbedObj1 As Object 'Attachment bit

Set Session = CreateObject("Notes.NotesSession")
UserName = Session.UserName
Set Maildb = Session.GETDATABASE("", MailDbName)
If Maildb.IsOpen = True Then
Else
Maildb.OPENMAIL
End If

Maildb.CreateDocument

Set MailDoc = Maildb.CreateDocument
MailDoc.Form = "Memo"
MailDoc.from = Sheets("Summary").Range("C6").Value
MailDoc.Subject = Sheets("Summary").Range("C8").Value & " RCR Request: "
& Sheets("Summary").Range("C10").Value & ", " &
Sheets("Summary").Range("C57").Value
MailDoc.principal = Sheets("Summary").Range("C6").Value
MailDoc.Body = Sheets("Additional information").Range("a31").Value

attachment1 = savedworkbook
'Attachment bit
Set AttachME = MailDoc.CREATERICHTEXTITEM("attachment1")
Set EmbedObj1 = AttachME.embedobject(1454, "attachment1",
attachment1, "")
Application.ScreenUpdating = True
'End Attachment bit

MailDoc.SaveMessageOnSend = True

On Error GoTo 0

sent = False

SendBit:
MailDoc.SaveMessageOnSend = True
While sent = False
On Error GoTo IncorrectAddressee
emailto = InputBox("Please enter the Lotus Notes name of who you
would like to send the RCR to:" & vbNewLine & "(Please remember that the RCR
will need authorisation first)", "Email Addressee", "") '"Enter Details
Here....")
If emailto = Cancel Then Exit Sub
MailDoc.SendTo = emailto 'Sheets("email wording").Range("a2").Value
MailDoc.SaveMessageOnSend = True
Call MailDoc.Send(False)
If ErrorMessage1 = "" Then
sent = True
ErrorMessage1 = ""
Else
sent = False
ErrorMessage1 = ""
End If
MailDoc.SaveMessageOnSend = True
GoTo sentok
IncorrectAddressee:
ErrorMessage1 = MsgBox("This form has not been submitted. Please
check the Lotus Notes name of the recipient and try again.", vbOKOnly,
"Incorrect Lotus Notes name")
Resume Next
sentok:
MailDoc.SaveMessageOnSend = True
Wend
MoreRecipients = MsgBox("Would you like to add another recipient?", vbYesNo,
"Multiple Recipients")
If MoreRecipients = vbYes Then
sent = False
GoTo SendBit
Else
MessageSent = MsgBox("Your email has now been successfully sent", vbOKOnly,
"Email Success")
End If
Exit Sub

ExitSub:
MsgBox ("This form has not been submitted. Please fill in all the
required fields and try again.")

Application.ScreenUpdating = True
Application.DisplayAlerts = True
Exit Sub

End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top