Sheet Range Through Lotus Notes - Nate O.?

[stapuff]

The following code provided by Nate O. & Van Pookie (thank you by the way) works great, however, I need help on making a change. This sends all values in column b to an e-mail Lotus Notes format. How can it change it to send all values in a range A1:D65536.end ray:

Dim Maildb As Object, UserName As String, MailDbName As String
Dim MailDoc As Object, Session As Object
Dim myStr As Variant
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 Not Maildb.IsOpen Then Maildb.OpenMail
Set MailDoc = Maildb.CreateDocument
MailDoc.Form = "Memo"
MailDoc.SendTo = "homer@simpson.com" 'Nickname or full address
'MailDoc.CopyTo = Whomever
'MailDoc.BlindCopyTo = Whomever
MailDoc.Subject = "Help Me"
With Range([B5], [B65536].End(3))
If IsArray(.Value) Then Let myStr = _
Join(WorksheetFunction.Transpose(.Value), "@") _
Else Let myStr = .Value
End With
MailDoc.Body = WorksheetFunction.Substitute( _
"Good afternoon!@@The following EO's are being sent to you@" _
& myStr & "@@Thank you and have a great weekend!", "@", vbCrLf)
MailDoc.SaveMessageOnSend = True
MailDoc.PostedDate = Now
Call MailDoc.Send(False)
Set Maildb = Nothing: Set MailDoc = Nothing: Set Session = Nothing
End Sub



Thanks,


Kurt

 

[Smitty]

Heya Kurt,

Does this help?

<font face=Tahoma><SPAN style="color:#00007F">Sub</SPAN> Stapuff()
    <SPAN style="color:#00007F">Dim</SPAN> Maildb <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Object</SPAN>, UserName <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN>, MailDbName <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN>
    <SPAN style="color:#00007F">Dim</SPAN> MailDoc <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Object</SPAN>, Session <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Object</SPAN>
    <SPAN style="color:#00007F">Dim</SPAN> myStr <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Variant</SPAN>
    <SPAN style="color:#00007F">Dim</SPAN> LastRow <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Object</SPAN>
        
        <SPAN style="color:#00007F">Set</SPAN> LastRow = Range("D65536").End(xlUp)
        <SPAN style="color:#00007F">Set</SPAN> Session = CreateObject("Notes.<SPAN style="color:#00007F">Not</SPAN>esSession")
        myStr = Range(Range("A1"), LastRow)
        
    UserName = Session.UserName
    MailDbName = Left$(UserName, 1) & Right$(UserName, _
    (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
    <SPAN style="color:#00007F">Set</SPAN> Maildb = Session.GetDatabase("", MailDbName)
    <SPAN style="color:#00007F">If</SPAN> Not Maildb.IsOpen <SPAN style="color:#00007F">Then</SPAN> Maildb.OpenMail
    <SPAN style="color:#00007F">Set</SPAN> MailDoc = Maildb.CreateDocument
    
    MailDoc.Form = "Memo"
    MailDoc.SendTo = "homer@simpson.com" <SPAN style="color:#007F00">'Nickname or full address</SPAN>
    <SPAN style="color:#007F00">'MailDoc.CopyTo = Whomever</SPAN>
    <SPAN style="color:#007F00">'MailDoc.BlindCopyTo = Whomever</SPAN>
    MailDoc.Subject = "Help Me"
    MailDoc.Body = myStr
    
    MailDoc.SaveMessageOnSend = <SPAN style="color:#00007F">True</SPAN>
    MailDoc.PostedDate = Now
    
    <SPAN style="color:#00007F">Call</SPAN> MailDoc.Send(False)
    <SPAN style="color:#00007F">Set</SPAN> Maildb = Nothing: <SPAN style="color:#00007F">Set</SPAN> MailDoc = <SPAN style="color:#00007F">Nothing</SPAN>: <SPAN style="color:#00007F">Set</SPAN> Session = Nothing

<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN></FONT>

Smitty

 

[stapuff]

Smitty -

Got the following run time error '7078' message.
"Could not create field %1" error on : MailDoc.Body = myStr

Kurt

 

[stapuff]

Folks,

In the code below - If I run the code w/ ** it will give me all the values in column a

If I run the code w/ *** it will give me all the values in row 1 a-d

What needs to be added to give me Columns a-d Row 1 - last row? Help is needed!


Thanks,


Kurt


Dim Maildb As Object, UserName As String, MailDbName As String
Dim MailDoc As Object, Session As Object
Dim myStr As Variant
Dim LastRow As Object
Dim CurRow As Object
Set LastRow = Range("A1:D65536").End(xlUp)
Set Session = CreateObject("Notes.NotesSession")
myStr = Range(Range("A1"), LastRow).Text

UserName = Session.UserName
MailDbName = Left$(UserName, 1) & Right$(UserName, _
(Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
Set Maildb = Session.GetDatabase("", MailDbName)
If Not Maildb.IsOpen Then Maildb.OpenMail
Set MailDoc = Maildb.CreateDocument

MailDoc.Form = "Memo"
MailDoc.SendTo = "homer@simpson.com" 'Nickname or full address
'MailDoc.CopyTo = Whomever
'MailDoc.BlindCopyTo = Whomever
MailDoc.Subject = "Inventory Issue's"
** MailDoc.Body = _
** Replace("Good afternoon!@@The following EO's are being sent to you@" _
** & Join(Application.Transpose(Range([a1], [a65536].End(3))), "@") _
** & "@@Thank you and have a great weekend!", "@", vbCrLf)
***MailDoc.Body = Range("A1") & " " & Range("B1") & " " & Range("C1") & " " & Range("D1")
MailDoc.SaveMessageOnSend = True
MailDoc.PostedDate = Now
Call MailDoc.Send(False)
Set Maildb = Nothing: Set MailDoc = Nothing: Set Session = Nothing

 

[NateO]

Hello Kurt,

Well, the join string function is going to want a 1-d array passed to it, which a1:d? is not.

How about a picture? E.g.,

http://www.mrexcel.com/board2/viewtopic.php?t=60558&start=13

 

[stapuff]

Nate -

I took the code you posted to Pook below this one. I overlooked it.

I copied , pasted, & ran the picture code changing only J.Deere to my e-mail address and the range A1-D20.

After running a awhile I got a warning message "MS Excel is waiting for another application to complete an OLE action."

I went to Lotus Notes where the picture was copied but asking for a valid address. I inputted my address into the address field. The message was sent. I then received another error -
"Run Time Error - '2147417851(80010105)': The server threw an exception. Hit debugged - highlighted "Call UIdoc.Send(false)


Looking at both codes from your e-mail to Kristy - I think I need a combination from both. I do not mind borders, font, etc.

The following is what I have right now that works (to a point). I have added a piece of code from Smitty that I like. It give me the ability to pick who gets the e-mail & allows me to change or delete when needed (easier).


Dim cell As Range, cnt As Integer, bodytext As String
Dim oBody As Object
Dim Maildb As Object, UserName As String, MailDbName As String
Dim MailDoc As Object, Session As Object
Dim myStr As Variant
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 Not Maildb.IsOpen Then Maildb.OpenMail
Set MailDoc = Maildb.CreateDocument
MailDoc.Form = "Memo"
Recipient = Sheets("E-Mail Addresses").Range("A2:A5").Value
MailDoc.SendTo = Recipient
Ans = MsgBox("Would you like to Copy (cc) anyone on this message?" _
, vbQuestion & vbYesNo, "Send Copy")
If Ans = vbYes Then
ccRecipient = InputBox("Please enter the additional recipient's e-mail address" _
, "Input e-mail address")
MailDoc.CopyTo = ccRecipient
End If
MailDoc.Subject = "Inventory Issues"
''With Range([b5], [b65536].End(3))
'' If IsArray(.Value) Then Let myStr = _
'' Join(WorksheetFunction.Transpose(.Value), "@") _
'' Else Let myStr = .Value
''End With
''MailDoc.Body = WorksheetFunction.Substitute( _
'' "Good afternoon!@@The following EO's are being sent to you@" _
'' & myStr & "@@Thank you and have a great weekend!", "@", vbCrLf)
Set oBody = MailDoc.CreateRichTextItem("Body")
cnt = 1
bodytext = "Here is a list of Negative numbers in DF Warehouse"
Call oBody.AppendText(bodytext)
Call oBody.AddNewLine(2)
For Each cell In Sheets("Sheet2").[A1:D20]
If cell.Row > cnt Then
Call oBody.AddNewLine(1)
cnt = cell.Row
End If
Call oBody.AppendText(cell.Value & " ")
Call oBody.addtab(3)
Call oBody.AddNewLine(1)
Next cell
MailDoc.SAVEMESSAGEONSEND = True
MailDoc.PostedDate = Now
Call MailDoc.Send(False)
Set Maildb = Nothing: Set MailDoc = Nothing: Set Session = Nothing


Thanks Nate for your time,


Kurt

 

[NateO]

Did you have your inbox db open when you ran the picture code?

 

[stapuff]

Nate -


I did have it open.

How can I change the - Call UIdoc.FieldSetText("SendTo", "John Deere") 'Recipient

to get the e-mail addresses from Sheets "E-Mail Addresses" Range A2:A5 instead of being hard coded?

Kurt

 

[NateO]

If you're using 5.0+ change:

Call UIdoc.FieldSetText("SendTo", "John Deere")

To:

Call UIdoc.FieldSetText("EnterSendTo", "John Deere")

IBM was nice enough to change the name of this field for us.

 

[NateO]

Just pass a range value.

"John Deere"

Becomes

[a1].value.