I have successfully found and altered some VBA that automatically sends and email to employees, from a spreadsheet, when it is determined their weekly hours don't meet the requirement. Currently it sends from my corporate outlook account. this email is 100% internal use. I would like to have the email sent so that it shows a "dummy" email in the from. We know this is possible, if I send it thru a specific server here in the office. Ideally i want the email to show it is from something like "timecheckatcompany.com" So my question is, how do I route thru a specific server and show the "dummy" email? What little i've found seems to be VBA from within Outlook itself, and in this case I am initiating from excel.

This is my code:
Sub SendAllMail()
'Setting up the Excel variables.
Dim olApp As Object
Dim olMailItm As Object
Dim iCounter As Integer
Dim Dest As Variant
Dim SDest As String
Dim xMailBody As String
Dim DateWindow As String
Dim dtToday As Date
Dim StartDate As Date
Dim EndDate As Date
Dim ReqHour As String
Dim objOutlookMsg As String


Worksheets("Team Lists").Activate
dtToday = Date
StartDate = Cells(1, "H").Value ' this is the date the tick hours start evaluation from
EndDate = Cells(1, "K") 'this is the end of the time period. 28 days is exactly 4 weeks. Alter the number 28 as appropriate if end date isnot correct
'DateWindow = StartDate & " to " & EndDate
'MsgBox (DateWindow)
'Create the Outlook application and the empty email.
ReqHour = Cells(1, "E")
Set olApp = CreateObject("Outlook.Application")
Set olMailItm = olApp.CreateItem(0)
xMailBody = "Hi there," & vbNewLine & vbNewLine & _
"It appears you have not logged enough hours this time Period."
'Using the email, add multiple recipients, using a list of addresses in column A.
With olMailItm
SDest = ""
For iCounter = 1 To WorksheetFunction.CountA(Columns(1))
If SDest = "" Then
SDest = Cells(iCounter, 1).Value
Else
SDest = SDest & ";" & Cells(iCounter, 1).Value
'MsgBox (SDest)
End If
Next iCounter

'Do additional formatting on the BCC and Subject lines, add the body text from the spreadsheet, and send.
.BCC = SDest
.Subject = " Review Needed!"
.Body = xMailBody
.Send
End With

'Clean up the Outlook application.
Set olMailItm = Nothing
Set olApp = Nothing
End Sub

It needs to go thrue MailServer Port 25 and the name of the server is data007.companyname.local