Macro for Lotus Notes

N

neveu

Board Regular
Joined
Jan 27, 2009
Messages
225
hi all,

could you please tell me if the VBA macro is compatible with Lotus Notes 6.5?

i would like to edit a macro designed for Outlook to be used with Lotus Notes.

thank you
 

Excel Facts

Easy bullets in Excel
If you have a numeric keypad, press Alt+7 on numeric keypad to type a bullet in Excel.
Sort by date Sort by votes
hello,
unfortunatly i was not able to find the code i have to modify in order to make my outlook VBA code work for Lotus notes (v6.5) :(.

i am copying the code below, maybe you could give some inputs/hint what do i have to change in order to make it compatible wiht Lotus.

to count recieved items:
Code: 
Sub BE_AP_INBOX()
Set objOLApp = CreateObject("Outlook.Application")
Set objExcel = CreateObject("Excel.Application")
Dim objFolders As Outlook.MAPIFolder
Dim MyInbox As Outlook.Items
Dim objNameSpace As Outlook.NameSpace
Dim objMsg As MailItem
Dim strBody As String
Dim iMeetCount As Integer
Dim intCount As Integer
Dim I As Integer
Dim dtPrevDate As Date
Dim blnDateChanged  As Boolean
Dim FileName As String
Dim LastRow As Integer
Set objNameSpace = objOLApp.GetNamespace("MAPI")
Set objFolders = objNameSpace.Folders("Mailbox - be ap").Folders("Inbox")
intCount = objFolders.Items.Count
Set objMsg = Application.CreateItem(olMailItem)
iMeetCount = 0
   
dtPrevDate = Date
I = 1
   
If dtPrevDate = DateValue(objFolders.Items(I).CreationTime) Then
iCount = iCount + 1
End If
For I = 1 To intCount
iMeetCount = iMeetCount + 1
Next

sFilter = "[ReceivedTime] >= '" & Format(Date - 8, " ddddd 23:59") & "'"
Set objItems = objFolders.Items.Restrict(sFilter)

objExcel.Visible = False
objExcel.Workbooks.Add
intZeile = 2
I = 2
For Each objItem In objItems
 If objItem.Class = olMail Then
  objExcel.Cells(1, 1) = "SENDER'S NAME"
  objExcel.Cells(I, 1) = objItem.SenderName
  objExcel.Cells(1, 2) = "RECEIVED TIME"
  objExcel.Cells(I, 2) = Format(objItem.ReceivedTime, "dd/mm/yyyy")
  objExcel.Cells(1, 3) = "EMAIL'S PARENT FOLDER"
  objExcel.Cells(I, 3) = objFolders.FolderPath
  
  objExcel.Cells(1, 5) = "Number of emails for today: "
  objExcel.Cells(2, 5) = "Total number of emails: "
  objExcel.Cells(1, 6) = objFolders.Items.Restrict(sFilter).Count
  objExcel.Cells(2, 6) = iMeetCount
 End If
I = I + 1
  
  Next
 
    If bRecursive Then
     If objFolder.Folders.Count Then
       objFolders , bRecursive
     End If
   End If
   
For I = 1 To 8
      objExcel.Columns(I).Autofit
      objExcel.Rows(I).Autofit
  Next I
On Error Resume Next
On Error GoTo 0
Set WBK = objExcel.ActiveWorkbook
'Make a copy of the active sheet and save it to a temporary file
WBK.SaveAs "X:\File path\Emails_Report.xls"
    
With WBK.Sheets("Sheet1")
  
 EndRngToCopy = .Cells(Rows.Count, "A").End(xlUp).Row
 WBK.Sheets("Sheet1").Range("A2:E" & EndRngToCopy).Select
 
End With
objExcel.Workbooks.Open "X:\File path\Emails_Report.xls"
    
With objExcel.ActiveWorkbook.Sheets("EMAILS EXPORT")
 
    LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
End With
  
WBK.Sheets("Sheet1").Range("A2:E" & EndRngToCopy).Copy Destination:=objExcel.ActiveWorkbook.Sheets("EMAILS EXPORT").Range("A" & LastRow + 1)
For I = 1 To 5
      objExcel.Columns(I).Autofit
      objExcel.Rows(I).Autofit
  Next I
           
 Set objMsg = Application.CreateItem(olMailItem)
 
 objMsg.To = "[EMAIL="mail@email.com"]mail@email.com[/EMAIL]"
    objMsg.CC = "[EMAIL="mail@email.com"]mail@email.com[/EMAIL]"
    objMsg.Subject = "recived -Count Inbox items"
    objMsg.Attachments.Add "X:\File path\Emails_Report.xls"
    objMsg.Body = strBody & "Hi," & vbCrLf & vbCrLf & "The number of the emails received by me today in my Inbox is " & objFolders.Items.Restrict(sFilter).Count & ". " & "The total number of received and not deleted emails in the Inbox is " & iMeetCount - objFolders.Items.Restrict(sFilter).Count & ". " & vbCrLf & vbCrLf & "Thank you." & vbCrLf & vbCrLf & "Bogdan" & vbCrLf
    objMsg.Send
    
   Set objMsg = Nothing
   Set objNameSpace = Nothing
   Set objFolders = Nothing
   Set objItems = Nothing
       
'Delete the temporary file
   objExcel.ActiveWorkbook.Close SaveChanges:=True
   WBK.Close SaveChanges:=True
   Kill "X:\File path\Emails_Report.xls"
   
 End Sub
[\code]
 
[B]to count sent items:[/B]
[code]
Sub BE_AP_SENT_ITEMS()
Set objOLApp = CreateObject("Outlook.Application")
Set objExcel = CreateObject("Excel.Application")
Dim objFolders As Outlook.MAPIFolder
Dim MyInbox As Outlook.Items
Dim objNameSpace As Outlook.NameSpace
Dim objMsg As MailItem
Dim strBody As String
Dim iMeetCount As Integer
Dim intCount As Integer
Dim I As Integer
Dim dtPrevDate As Date
Dim blnDateChanged  As Boolean
Dim FileName As String
Dim LastRow As Integer
Set objNameSpace = objOLApp.GetNamespace("MAPI")
Set objFolders = objNameSpace.Folders("Mailbox - Name").Folders("Sent Items")
intCount = objFolders.Items.Count
Set objMsg = Application.CreateItem(olMailItem)
iMeetCount = 0
    
    
dtPrevDate = Date
I = 1
    
If dtPrevDate = DateValue(objFolders.Items(I).CreationTime) Then
iCount = iCount + 1
End If
For I = 1 To intCount
iMeetCount = iMeetCount + 1
Next

sFilter = "[ReceivedTime] >= '" & Format(Date - 8, " ddddd 23:59") & "'"
Set objItems = objFolders.Items.Restrict(sFilter)

objExcel.Visible = False
objExcel.Workbooks.Add
intZeile = 2
I = 2
For Each objItem In objItems
 If objItem.Class = olMail Then
  objExcel.Cells(1, 1) = "SENDER'S NAME"
  objExcel.Cells(I, 1) = objItem.SenderName
  objExcel.Cells(1, 2) = "RECEIVED TIME"
  objExcel.Cells(I, 2) = Format(objItem.ReceivedTime, "dd/mm/yyyy")
  objExcel.Cells(1, 3) = "EMAIL'S PARENT FOLDER"
  objExcel.Cells(I, 3) = objFolders.FolderPath
  
  objExcel.Cells(1, 5) = "Number of emails for today: "
  objExcel.Cells(2, 5) = "Total number of emails: "
  objExcel.Cells(1, 6) = objFolders.Items.Restrict(sFilter).Count
  objExcel.Cells(2, 6) = iMeetCount
 End If
I = I + 1
  
  Next
 
    If bRecursive Then
     If objFolder.Folders.Count Then
       objFolders , bRecursive
     End If
   End If
   
For I = 1 To 8
      objExcel.Columns(I).Autofit
      objExcel.Rows(I).Autofit
  Next I
On Error Resume Next
On Error GoTo 0
Set WBK = objExcel.ActiveWorkbook
'Make a copy of the active sheet and save it to a temporary file
WBK.SaveAs "X:\File path\Emails_Report.xls"
    
With WBK.Sheets("Sheet1")
  
 EndRngToCopy = .Cells(Rows.Count, "A").End(xlUp).Row
 WBK.Sheets("Sheet1").Range("A2:E" & EndRngToCopy).Select
 
End With
objExcel.Workbooks.Open "X:\File path\Emails_Report.xls"
    
With objExcel.ActiveWorkbook.Sheets("EMAILS EXPORT")
 
    LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
End With
  
WBK.Sheets("Sheet1").Range("A2:E" & EndRngToCopy).Copy Destination:=objExcel.ActiveWorkbook.Sheets("EMAILS EXPORT").Range("A" & LastRow + 1)
For I = 1 To 5
      objExcel.Columns(I).Autofit
      objExcel.Rows(I).Autofit
  Next I
           
 Set objMsg = Application.CreateItem(olMailItem)
 
 objMsg.To = "[EMAIL="mail@email.com"]mail@email.com[/EMAIL]"
    objMsg.CC = "[EMAIL="mail@email.com"]mail@email.com[/EMAIL]"
    objMsg.Subject = "Sent Count Inbox items - worker 1"
    objMsg.Attachments.Add "X:\File path\Emails_Report.xls"
    objMsg.Body = strBody & "Hi," & vbCrLf & vbCrLf & "The number of the emails received by me today in my Inbox is " & objFolders.Items.Restrict(sFilter).Count & ". " & "The total number of received and not deleted emails in the Inbox is " & iMeetCount - objFolders.Items.Restrict(sFilter).Count & ". " & vbCrLf & vbCrLf & "Thank you." & vbCrLf & vbCrLf & "Bogdan" & vbCrLf
    objMsg.Send
    
   Set objMsg = Nothing
   Set objNameSpace = Nothing
   Set objFolders = Nothing
   Set objItems = Nothing
       
'Delete the temporary file
   objExcel.ActiveWorkbook.Close SaveChanges:=True
   WBK.Close SaveChanges:=True
   Kill "X:\File path\Emails_Report.xls"
   
 End Sub
[\code]
 
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Question Question
Assistance changing VBA code to display as HTML or picture of a selection in Lotus Notes
Replies
2
Views
234
jularobert
J
B
  • Question Question
Need a vba macro to combine sheets based on date in file name
Replies
1
Views
258
Rijnsent
Rijnsent
R
  • Question Question
Font control for cell Notes and Comments
Replies
3
Views
106
Roland Hoelscher
R
F
  • Question Question
Auto note / comment
Replies
3
Views
55
saboh12617
S
X
  • Question Question
Excel VBA Code required to access other applications
Replies
5
Views
377
xsdip
X

Forum statistics

Threads
1,224,609
Messages
6,179,875
Members
452,949
Latest member
Dupuhini

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top