Outlook to lotusnotes

[Jagadeeshbs]

hi all,


i have VBA code which uses the outlook to send mails, but now i need it the same for lotus notes.


here is my code which i have used in the past.


Sub ExportEmailManual()


Dim ObjFile As FileSystemObject

Dim x, xDate, z

Dim xNewFolder

Dim olApp As Outlook.Application

Dim olMail As Outlook.MailItem

Dim Rng As Range

Dim objOLAttach As Outlook.Attachment

Dim NameX As Name, xDir, xFile, xMonth, xPath, xStp, xDist

Dim xEmailTo, xEmailCC, xEmailBCC, xCurrentName


Application.DisplayAlerts = False


Sheets("UserMaster").Visible = True

Sheets("UserMaster").Select


Range("A2").Select

Do While ActiveCell.Value <> "" Or ActiveCell.Value <> vbNullString

xCurrentName = ActiveCell.Value

x = ActiveWorkbook.Name


xDate = Date


Application.StatusBar = "Preparing Email Attachment..."

Application.ScreenUpdating = False


Sheets("InterCompany Recon rpt").Select

Range("A2").Value = xCurrentName

Application.Calculation = xlCalculationAutomatic


Sheets(Array("InterCompany Recon rpt")).Copy

Sheets(Array("InterCompany Recon rpt")).Select

Cells.Select

Selection.Copy

Selection.PasteSpecial Paste:=xlValues

Range("A1").Select

Rows("1:3").Delete

Columns("A:C").Delete

Columns("A:A").Insert xlShiftToRight

Columns("A:A").ColumnWidth = 1

Range("A4").Select

Do While ActiveCell.Row < 24

ActiveCell.Offset(0, 10).Formula = "=IF(ISERROR(" & ActiveCell.Offset(0, 4).Address & "+" & ActiveCell.Offset(0, 7).Address & "),0, " & ActiveCell.Offset(0, 4).Address & "+" & ActiveCell.Offset(0, 7).Address & ")"

ActiveCell.Offset(0, 12).Formula = "=IF(ISERROR(" & ActiveCell.Offset(0, 10).Address & "*" & ActiveCell.Offset(0, 11).Address & "),0, " & ActiveCell.Offset(0, 10).Address & "*" & ActiveCell.Offset(0, 11).Address & ")"

ActiveCell.Offset(1, 0).Select

Loop

z = ActiveWorkbook.Name


Windows(z).Activate

Range("A1").Select


Sheets("InterCompany Recon rpt").Select


Application.CutCopyMode = False


Dim nName As Name

For Each nName In Names

nName.Delete

Next nName

xDir = "C:SavedReports" & Format(xDate, "yyyy") & ""


xMonth = Format(xDate, "mm mmmm")

xFile = "CHReport_" & xCurrentName & Format(xDate, "dd-mm-yyyy") & ".xlsx"

xPath = xDir & xMonth & xFile


Set ObjFile = New FileSystemObject

If ObjFile.FolderExists(xDir & xMonth) Then

If ObjFile.FileExists(xPath) Then

ObjFile.DeleteFile (xPath)

Application.Workbooks(z).SaveAs Filename:=xPath

Application.ActiveWorkbook.Close

Else

Application.Workbooks(z).SaveAs Filename:=xPath

Application.ActiveWorkbook.Close

End If

Else

xNewFolder = xDir & xMonth

MkDir xNewFolder

Application.Workbooks(z).SaveAs Filename:=xPath

Application.ActiveWorkbook.Close

End If

Workbooks(x).Activate


Set olApp = New Outlook.Application

Dim olNs As Outlook.Namespace

Set olNs = olApp.GetNamespace("MAPI")

olNs.Logon

Set olMail = olApp.CreateItem(olMailItem)


olMail.To = [sendMailTo]


olMail.Subject = " Intercompany reconciliation report for " & MonthName(DatePart("m", Date) - 1) + Str(Year(Date))

olMail.Body = "Dear All," _

& vbCrLf & vbCrLf & "Please find the attached Intercompany Reconciliation Report for " & MonthName(DatePart("m", Date) - 1) + Str(Year(Date)) & ". Please fill in and send it back as soon as possible." _

& vbCrLf & vbCrLf & "Regards," _

& vbCrLf & "Jagadeesh B S " _

& vbCrLf & "" _

& vbCrLf & vbCrLf


olMail.Attachments.Add xPath


Range("A1").Select


olMail.Display


Sheets("Usermaster").Select

ActiveCell.Offset(1, 0).Select

Loop

Application.StatusBar = False

Application.ScreenUpdating = True

Application.DisplayAlerts = True

End Sub

 

[shrivallabha]

As a starting point, you can use this link:

http://www.vbaexpress.com/forum/showthread.php?t=35917


However, I won't be able to support you if you need any major change to that code as I do not use Lotus Notes anymore.