Find dates in Excel with VB Script

If you need help understanding anything (except nuclear physics) let me know.

If you don't, how can I add a few lines of code to make the script open Outlook first, then send, then close Outlook?  Also, Outlook gets a pop up asking if I want to Allow or Deny sending of the email, do you know how to turn this off?

strMessage = "SERVERS EXPIRING YOU IDIOT"
strTo= "user"
strFrom="user"
strSubject="test"
strAccountID="user"
strPassword="password"
strSMTPServer="smtp.server.com"
SendMail strTo,strFrom,strSubject,strMessage,strAccountID,strPassword,strSMTPServer


' send email using public mail servers
Function SendMail( strFrom, strSendTo, strSubject, strMessage , strUser, strPassword, strSMTP )

	Set oEmail = CreateObject("CDO.Message")
	
	'configure message
	With oEmail.Configuration.Fields
          .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 
          .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strSMTP
          .item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1 'basic
          .item("http://schemas.microsoft.com/cdo/configuration/sendusername") = strUser
          .item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = strPassword
          .Update
	End With
	
	' build message
	With oEmail
	     .From = strFrom
	     .To = strSendTo 
	     .Subject = strSubject
	     .TextBody = strMessage
	End With
	
	' send message
	On Error Resume Next
	oEmail.Send
	If Err Then
	     WScript.Echo "SendMail Failed:" & Err.Description
	End If
		
End Function

Select allOpen in new window

Dim objExcel
Dim objOutlook
Dim objMail
Dim objWB
Dim objWS
Dim vCell
Dim wsIndex, bodyText, blnServersFound, arrDateParts, dtePurchaseDate
Dim strServer, strTo, strFrom, strSubject

strServer = "mailhost.abc.com"
strTo = "user@domain.com"
strFrom = "john.doe@abc.com"
strSubject = "Servers expiring soon"

Const xlUp = -4162
 
Set objExcel = CreateObject("Excel.Application")
 
objExcel.DisplayAlerts = False
objExcel.Visible = True
objExcel.Workbooks.Open ("C:\ServerInventory.XLSX")
Set objWB = objExcel.ActiveWorkbook
bodyText = "The following servers are nearing their 4 year replacement:" & vbNewLine & vbNewLine
blnServersFound = False
For wsIndex = 1 To objWB.Sheets.Count
    Set objWS = objWB.Worksheets(wsIndex)
    For Each vCell In objWS.Range("J2:J" & objWS.Cells(objWS.Rows.Count, "J").End(xlUp).Row).Cells
       	arrDateParts = Split(vCell, "/")
       	If UBound(arrDateParts) = 2 Then
            dtePurchaseDate = FormatDateTime(arrDateParts(1) & "/" & MonthName(arrDateParts(0), True) & "/" & arrDateParts(2))
			If Date >= DateAdd("yyyy", 4, FormatDateTime(dtePurchaseDate)) Then
				bodyText = bodyText & "Server " & objWS.Cells(vCell.Row, "B").Value & " (" & objWS.Cells(vCell.Row, "G").Value & " - " &_
					objWS.Cells(vCell.Row, "H").Value & ") has reached its end of life, which was " & dtePurchaseDate & vbNewLine
				blnServersFound = True
			End If
		End If
    Next
Next

If blnServersFound = True Then
	SendEmail strServer, strTo, strFrom, strSubject, bodyText, ""
End If
 
objWB.Save
objWB.Close
objExcel.Quit
 
Set objExcel = Nothing
Set objWB = Nothing
Set objWS = Nothing

Sub SendEmail(strServer, strTo, strFrom, strSubject, strBody, strAttachment)
        Dim objMessage
        
        Set objMessage = CreateObject("CDO.Message")
        objMessage.To = strTo
        objMessage.From = strFrom
        objMessage.Subject = strSubject
        objMessage.TextBody = strBody
  		If strAttachment <> "" Then objMessage.AddAttachment strAttachment
  		
        '==This section provides the configuration information for the remote SMTP server.
        objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
        'Name or IP of Remote SMTP Server
        objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strServer
        'Server port (typically 25)
        objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25      
        objMessage.Configuration.Fields.Update
        '==End remote SMTP server configuration section==
 
        objMessage.Send
        Set objMessage = Nothing
End Sub

Select allOpen in new window