Do you have an corp email acct that does not allow Internet access? Well use this macro to send email msgs and meetings to your gmail acct:
Sub SendGmail(Item As Outlook.MailItem)
On Error GoTo ErrHandler
Dim objMsg As MailItem
Set objMsg = Application.CreateItem(olMailItem)
Dim iCfg As Object
Dim iMsg As Object
Dim srecs As String
Dim sTo As String
For Each Recipient In Item.Recipients
srecs = srecs & Recipient & ","
Next Recipient
Dim sb As String
sb = "Original Message: Sender = " & Item.SenderName & ":" & Item.Sender & ", To = " & Item.To & ", Recepients = " & srecs & vbCrLf & "Body-> " & Item.Body
objMsg.Body = sb 'Item.Body
objMsg.Subject = "FW: " & Item.Subject
objMsg.Recipients.Add "YOU@gmail.com"
objMsg.Send
ExitSub:
'any always-execute (cleanup?) code goes here -- analagous to a Finally block.
'don't forget to do this -- you don't want to fall into error handling when there's no error
Exit Sub
ErrHandler:
'can Select Case on Err.Number if there are any you want to handle specially
'display to user
MsgBox "Something's wrong: " & vbCrLf & Err.Description
Resume ExitSub
Resume
End Sub
Sub ForwardMeetingDetails(oRequest As MeetingItem)
On Error GoTo ErrHandler
Dim oAppt As AppointmentItem
Set oAppt = oRequest.GetAssociatedAppointment(True)
Dim fwdAppt As MailItem
Set fwdAppt = Application.CreateItem(olMailItem)
strBody = "Organizer: " & oAppt.Organizer & vbCrLf _
& "Start: " & oAppt.Start & vbCrLf & "End: " & oAppt.End _
& vbCrLf & "Location: " & oAppt.Location & vbCrLf & "Message: " & oAppt.Body
With fwdAppt
.Recipients.Add "jrdtechnologiesapps@gmail.com"
.Recipients.Add "jrdtechnologies@gmail.com"
.Subject = "ATT FW MTG: " & oAppt.Subject
.Body = strBody
.Send
End With
ExitSub:
'any always-execute (cleanup?) code goes here -- analagous to a Finally block.
'don't forget to do this -- you don't want to fall into error handling when there's no error
Exit Sub
ErrHandler:
'can Select Case on Err.Number if there are any you want to handle specially
'display to user
MsgBox "Something's wrong: " & vbCrLf & Err.Description
Resume ExitSub
End Sub
No comments:
Post a Comment