VBA code fails when adding another step to truncate cell data

[rbalentine]

Hi All,
I have used this code for some time now, but for some reason am getting a vba error when running.

The object of this code is to take data in excel cells and use this data to compile a lotus notes email.

The problem happens (vba error recieved) when the text from the excel spreadsheet is to be pasted into body of the email.

The body being pasted as text comes from the excel cells E48 through E65.
This was working, but has not since I had to truncate the data.

The user grabs data from a webpage and pastes into cells. The data is manipulated slightly to make for a nice consistent email. See the example below to help explain.

A user pastes text from the web into cell E1
The cell X1 tests if a particular string is present, and if so, uses the content. If not, produces "Not Found".

The cell E50 formats the text into a consistent email message.

The problem is if the text pasted into E1 is greater than 255 characters, the formula in X1 returns "Not Found" even though there is a match.

(This is easily overcome by adding a second step to truncate the data.)

Then, a user hits a button to send the mail and vba code is invoked and copies the contents of E50 and pastes into the body of the email.

This works fine under the below scenario.
E1: From Web: This is text that was pasted from a webpage and should be included in the email, blah, blah, blah

(If E1 contains the text "From Web", then use it, if not return not found)
X1: =if(match("From Web:*",E1,0)=TRUE,E1,"Not Found")

(E50 contains the text that is pasted into the body of the email)
E50: =if(X1="Not Found","No Data Pasted",CONCATENATE("We have gathered this text ",X1," from the webpage"))

Now, if the data pasted from the web into E1 exceeds 255 characters, I have added a second set of checks to truncate. It appears this will work, but when I do this, the vba code fails. Not sure why?

E1: From Web: This is text that was pasted from a webpage and should be included in the email, blah, blah, blah

(Here I check to see if the text is greater than 255, if so, use the left most 255 characters, if not, just copy from E1 to W1
W1: =if(len(E1)>255,left(E1,255),E1)

X1 if(match("From Web:*",W1,0)=TRUE,W1,"Not Found")

E50: =if(X1="Not Found","No Data Pasted",CONCATENATE("We have gathered this text ",X1," from the webpage"))

So now, the resulting data in E50 is trucated data from E1. No big deal, right?

Well, when adding this extra step of cell W1, the vba code fails.
Keep in mind, when this step is omitted and W1 is not used, the vba code works every time....

The exectution fails when hitting this line in the vba code:

Code:

Body1 = Replace(Join(Application.Transpose(Range([E48], [E65].End(3))), "@") & "@@Thank you,", "@", vbCrLf)

I get the error

Run-time error '-2147417848(80010108)':
Automation error
The object invoked has disconnected from it's clients

I know the code is not the greatest as I have pieced it together from several sample codes. I am not very familiar with VBA, so I am probably missing some DIM statements, and probably alot of other stuff.

Can someone please look at this and let me know what else is needed in the code to overcome this error.
Any help is appreciated as I dont have enough knowledge to troubleshoot this myself.

Code:

Sub Email_Web_Data_Send_Email()
'This macro does the following:
' A. Using the Lotus Notes 6.5 or 7
' B. Opens a new memo message using the current email box open
' C. Copies data from the excel spreadsheet, email addresses, subject, and body
' D. Pastes this data as TEXT into the email
' E. If a user has an auto signature, this is preserved
Dim Notes As Object
Dim db As Object
Dim WorkSpace As Object
Dim UIdoc As Object
Dim UserName As String
Dim MailDbName As String
Set Notes = CreateObject("Notes.NotesSession")
UserName = Notes.UserName
MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
Set db = Notes.GetDataBase(vbNullString, MailDbName)
Set WorkSpace = CreateObject("Notes.NotesUIWorkspace")
Call WorkSpace.ComposeDocument(, , "Memo")
Set UIdoc = WorkSpace.CurrentDocument
'If cells are null, such as email address, cc, etc, then ignore and dont paste into email
On Error Resume Next
'Copy the email address from cell E40 into the TO: field in Lotus Notes
'Note:  Addresses in this cell should be separated by a semicolon
Recipient = Sheets("Email.Web.Data").Range("E40").Value
Call UIdoc.FieldSetText("EnterSendTo", Recipient)
'Copy the email address from cell E41 into the CC: field in Lotus Notes
'Note:  Addresses in this cell should be separated by a semicolon
ccRecipient = Sheets("Email.Web.Data").Range("E41").Value
Call UIdoc.FieldSetText("EnterCopyTo", ccRecipient)
'Copy the email address from cell E42 into the BCC: field in Lotus Notes
'Note:  Addresses in this cell should be separated by a semicolon
bccRecipient = Sheets("Email.Web.Data").Range("E42").Value
Call UIdoc.FieldSetText("EnterBlindCopyTo", bccRecipient)
'Copy the subject from cell E45 into the SUBJECT: field in Lotus Notes
Subject1 = Sheets("Email.Web.Data").Range("E45").Value
Call UIdoc.FieldSetText("Subject", Subject1)
'Copy the reply to address from cell from cell E43 into the Replies should be
'directed to: (Advanced Options) field in Lotus Notes
RepliesTo = Sheets("Email.Web.Data").Range("E43").Value
Call UIdoc.Document.ReplaceItemValue("ReplyTo", RepliesTo)
'Copy the cells in the range (one column) into the BODY in Lotus Notes
Call UIdoc.GotoField("Body")
'HERE IS WHERE THE CODE FAILS NEXT LINE
Body1 = Replace(Join(Application.Transpose(Range([E48], [E65].End(3))), "@") & "@@Thank you,", "@", vbCrLf)
Call UIdoc.InsertText(Body1)
'Insert some carriage returns at the end of the email
Call UIdoc.InsertText(vbCrLf & vbCrLf)
Application.CutCopyMode = False
Set UIdoc = Nothing: Set WorkSpace = Nothing
Set db = Nothing: Set Notes = Nothing