Hi, can u suggest any improvement on the below code.
=======================================================================================
'this function returns email id to respective name. These emailid's are available in the outlook.
Function EmailAdd(nameid) As String
Select Case nameid
' add the name as it is in the excel
Case "Zakir"
nameid = "xxxxxx@xxxxxxxx"
Case "Joy"
nameid = "xxxxx@xxxx.com"
End Select
End Function
===================================================================================
'Main fucntion
Sub SendEmailToPlafrom()
Dim strPath As String
strPath = 'path of file
'myFileExists function calls the fucntion to check if the file exists
If myFileExists(strPath, True) Then
Dim xlApp As Object
Dim sourceWB As Workbook
Dim sourceWS As Worksheet
Set xlApp = CreateObject("Excel.Application")
Dim myDate As Date
'my date is the date format which is same as date in excel
myDate = Format(Date, "mm/dd/yyyy")
'set outlook
Set olApp = New Outlook.Application
Dim olNs As Outlook.NameSpace
Dim olMail As Outlook.MailItem
Set olNs = olApp.GetNamespace("MAPI")
Set olMail = olApp.CreateItem(olMailItem)
'opens and retrives the value from excel
Set sourceWB = Workbooks.Open(strPath)
Set sourceWH = sourceWB.Worksheets("Sheet1")
lastrow = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
I = 3 'since the date starts from 3rd row
If myDate > Cells(lastrow, 2) Then 'check if mydate is greater that the date in excel
name1 = "False"
Else
Do Until I = lastrow
If Cells(I, 1) <= myDate And Cells(I, 2) >= myDate Then
If (myDate) >= (Cells(lastrow, 2) - 5) Then
Result5 = MsgBox("The IM
ncall is till" & Cells(lastrow, 2).Value & ",Do you want to sent mail to remainder to IMO", vbYesNo)
If Result5 = Yes Then
With olMail
.To = "xxxxx@gmail.com"
.Subject = "Kindly provide with the latest On_Call sheet"
End With
olMail.Display
End If
End If
searchstring = Cells(I, 3).Value
If InStr(searchstring, "|") > 0 Then
pos = InStr(1, searchstring, "|")
name1 = Trim(Mid(searchstring, 1, pos - 1))
name2 = Trim(Mid(searchstring, pos + 1))
strEmailTo1 = EmailAdd(name1)
strEmailTo2 = EmailAdd(name2) ' this function gives the emailid to that respective name. manualy entered.
Else
name1 = Trim(searchstring)
strEmailTo1 = EmailAdd(name1) ' this function gives the emailid to that respective name. manualy entered.
End If
End If
If pos <> 0 Then Exit Do
I = I + 1
Loop
End If
'Clean up
Set xlWS = Nothing
Set xlWB = Nothing
xlApp.Quit
Set xlApp = Nothing
End If
If name1 = False Then
With olMail
.To = "xxxxxxxx@gmail.com"
.CC = strEmailCC
.Subject = "Kindly provide with the latest On_Call sheet"
.Body = "Hi" & vbCrLf & "Kindly sent an updated On_Call sheet." & vbNewLine & "The last date available is" & " " & Cells(lastrow, 2) & vbNewLine
End With
olMail.Display
Else
strEmailCC = "xxxxx@rediffmail.com ;
xxxxx@gmail.com"
olMail.To = name1
olMail.Body = "Good Morning, " & vbCrLf & olMail.Body
End If
olMail.Display
Exit Sub
End Sub