Help changing a macro

[gurtej176]

Hi All VBA Experts,
I have a question. We are using lotus notes and use a workbook with different sheets in it that represents spend for each state and city. Now I need a macro that I can have on the main summary page so that when I click, it send individual worksheets out to email adress in cells A1 as attachment. At the same time I need the body of email to be what is in from cells B123 to B150. Below is my requirment:
1) One marco in a workbook to send different worksheets out to different email adresses in A1 of individual worksheet.
2) In CC: filed I want a different email adress
3) IN subject, the wording should be what is in cell B3 of individual sheet
3) The body of the email needs to be the same wording as what is in the range mentioned above.

As of now, I am using the below macro for a different scenario that was provided to be by one of the experts here:

what the below macro does is:
1) Send an email out to the adress in B195
2) IN cc field it copies the address from B196
3) IN subject it copies from B197
and the body is from B198 to B209.

Now can anyone let me know how to modilfy it to accomodate my current requirments....also it would be good if you can advice me how to send it straight without looking at it in lotus notes....

sub Send_Excel_Cell_Content_To_Lotus_Notes()

'This macro does the following:
' A. Confirmed working on Excel 2003
' B. Opens Lotus Notes 6.5 or 7
' C. Opens a new memo message
' D. Copies data from the excel spreadsheet, email addresses, subject, and body
' E. Pastes this data as TEXT into the email
' F. If a user has auto signature already configured in lotus notes, this is preserved (either html or text)

Dim Notes As Object
Dim Maildb 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 Maildb = 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 B2 into the TO: field in Lotus Notes
'Note: Addresses in this cell should be separated by a semicolon.
'Please change your current sheet's name from Sheet1 to your sheet's name
Recipient = Sheets("Alerts").Range("B195").Value
Call UIdoc.FieldSetText("EnterSendTo", Recipient)

'Copy the email address from cell B3 into the CC: field in Lotus Notes
'Note: Addresses in this cell should be separated by a semicolon
ccRecipient = Sheets("Alerts").Range("B196").Value
Call UIdoc.FieldSetText("EnterCopyTo", ccRecipient)

'Copy the subject from cell B4 into the SUBJECT: field in Lotus Notes
Subject1 = Sheets("Alerts").Range("B197").Value
Call UIdoc.FieldSetText("Subject", Subject1)

'Copy the cells in the range (one column going down) into the BODY in Lotus Notes.
'You must set the last cell B9 to one cell below the range you wish to copy.
Call UIdoc.GotoField("Body")
Body1 = Replace(Join(Application.Transpose(Range([B198], [B209].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 Maildb = Nothing: Set Notes = Nothing
Set Body = Nothing

MsgBox ("Please check the New Memo Tab in your Lotus Notes")

End Sub

 

[gurtej176]

can anyone please help?

 

[gurtej176]

Hi Guys,

I have found another macro and it does send out the sheets individually, but below is the list of thing that it does not do:
1) Only one sublject line for each sheet, whereas I want to be different for each individual sheet on the basis of one unique coloumn
2) The attachement name needs to be same as the sheet name which is not the case at the moment
2)I want different body wording in different emails based on unique range in each sheet..
can someone please help


Sub Mail_Every_Worksheet()
'Working in 97-2010
Dim sh As Worksheet
Dim wb As Workbook
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim TempFilePath As String
Dim TempFileName As String
Dim I As Long
TempFilePath = Environ$("temp") & "\"
If Val(Application.Version) < 12 Then
'You use Excel 97-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'You use Excel 2007-2010
FileExtStr = ".xlsm": FileFormatNum = 52
End If
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
For Each sh In ThisWorkbook.Worksheets
If sh.Range("A1").Value Like "?*@?*.?*" Then
sh.Copy
Set wb = ActiveWorkbook
TempFileName = "Sheet " & sh.Name & " of " _
& ThisWorkbook.Name & " " _
& Format(Now, "dd-mmm-yy h-mm-ss")
With wb
.SaveAs TempFilePath & TempFileName & FileExtStr, _
FileFormat:=FileFormatNum
On Error Resume Next
For I = 1 To 3
.SendMail sh.Range("A1").Value, _
"This is the Subject line"
If Err.Number = 0 Then Exit For
Next I
On Error GoTo 0
.Close SaveChanges:=False
End With
'Delete the file you have send
Kill TempFilePath & TempFileName & FileExtStr
End If
Next sh
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub

 

[gurtej176]

guys, is this really tough? If yes then I may need to look out for other ways?

 

[gurtej176]

Any help guys?

 

[gurtej176]

Hi All,

Just to let you know that we got some external help for the above requirment, and just a feedback on the above:
1) if you are using lotus notes, is way tougher to send an email with worksheet as attachment and at the same time body of email as well.

2) U cant send a body of email as well as sheet as attachement without user intervenstion, you can create an email in lotus notes but notes will still ask ur permission before it will send an email.
3) Or you can send the sheet out with email automatically without user intervention, but you cannot have the body of email then.

So thats it.