Friday, July 18, 2014

Outlook to forward Email

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