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
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