Results 1 to 4 of 4

Thread: script: howto forward selected email using excel VBA

  1. #1

    Thread Starter
    Member
    Join Date
    Mar 2013
    Posts
    40

    script: howto forward selected email using excel VBA

    Dears,
    due to user limitations at the office for outlook I need to find a script that allows me to select a mail modify the subject and forward it to a fix email adres, adapt the from field into my own email adres.
    however I've been googling to find any answers but unfortunatly I didn't find any besided creating an standard email using excel vba.

    example in the mail is comming from testuser@testcenter.com
    subject testmail
    if you click just on the forward button you get as subject
    Fw: testmail
    now I need to remove the Fw: and replace it with (Grid:xxxxxxxx)
    remove my signature and sent the mail

    and if it's possible to store the subjectline in an excel sheet
    this is what I have so far but I get an error on with or variable object not set
    Code:
    Sub testforward()
    Dim OutApp As Outlook.Application
    Dim OutMail As Outlook.MailItem
    Dim msg As Outlook.MailItem
    Dim nms As Outlook.Namespace
    Dim fld As Outlook.MAPIFolder
    Dim itm As Object
    Dim objForward As Object
    strSheet = "OutlookItems.xls"
    strPath = "C:\Temp\"
    strSheet = strPath & strSheet
    Debug.Print strSheet  'Select export folderSet nms = Application.GetNamespace("MAPI")
    Set fld = nms.PickFolder  'Handle potential errors with Select Folder dialog box.
    If fld Is Nothing Then
    MsgBox "There are no mail messages to export", vbOKOnly, _
    "Error"
    Exit Sub
    ElseIf fld.DefaultItemType <> olMailItem Then
    MsgBox "There are no mail messages to export", vbOKOnly, _
    "Error"
    Exit Sub
    ElseIf fld.Items.Count = 0 Then
    MsgBox "There are no mail messages to export", vbOKOnly, _
    "Error"
    Exit Sub
    End If  'Open and activate Excel workbook.
    Set appExcel = CreateObject("Excel.Application")
    appExcel.Workbooks.Open (strSheet)
    Set wkb = appExcel.ActiveWorkbook
    Set wks = wkb.Sheets(1)
    wks.Activate
    appExcel.Application.Visible = True  'Copy field items in mail folder.
    For Each itm In fld.Items
    intColumnCounter = 1
    Set msg = itm
    intRowCounter = intRowCounter + 1
    Set rng = wks.Cells(intRowCounter, intColumnCounter)
    rng.Value = msg.To
    intColumnCounter = intColumnCounter + 1
    Set rng = wks.Cells(intRowCounter, intColumnCounter)
    rng.Value = msg.SenderEmailAddress
    intColumnCounter = intColumnCounter + 1
    Set rng = wks.Cells(intRowCounter, intColumnCounter)
    rng.Value = msg.Subject
    intColumnCounter = intColumnCounter + 1
    Set rng = wks.Cells(intRowCounter, intColumnCounter)
    rng.Value = msg.SentOn
    intColumnCounter = intColumnCounter + 1
    Set rng = wks.Cells(intRowCounter, intColumnCounter)
    rng.Value = msg.ReceivedTime
    Next itm
    Set appExcel = Nothing
    Set wkb = Nothing
    Set wks = Nothing
    Set rng = Nothing
    Set msg = Nothing
    Set nms = Nothing
    Set fld = Nothing
    Set itm = Nothing
    Exit Sub
    
    SubErrHandler: If Err.Number = 1004 Then
    MsgBox strSheet & " doesn't exist", vbOKOnly, _
    "Error"
    Else
    MsgBox Err.Number & "; Description: ", vbOKOnly, _
    "Error"
    End If
    Set appExcel = Nothing
    Set wkb = Nothing
    Set wks = Nothing
    Set rng = Nothing
    Set msg = Nothing
    Set nms = Nothing
    Set fld = Nothing
    Set itm = Nothing
    
    'Set OutApp = New Outlook.Application
    'Set OutMail = OutApp.CreateItem(olMailItem)
    '
    'If Not OutMail Is Nothing Then
    'Set objForward = OutMail.Forward
    'objForward.SentOnBehalfOfName = "from@email.com"
    'objForward.To = "me@me.com"
    'objForward.Display
    'End If
    
    End Sub
    thanks for your help to find my error and modify the script to adapt the subject and remove the signature

  2. #2
    PowerPoster
    Join Date
    Dec 2004
    Posts
    25,618

    Re: script: howto forward selected email using excel VBA

    try like
    Code:
        Set myItem = ActiveExplorer.Selection(1).Forward
        myItem.Subject = Replace(myItem.Subject, "Fwd:", "Grid:xxxxxxxx")
        Set r = myItem.Recipients.Add
        r.Name = "Me"
        r.AddressEntry = "me@myserver.com"
        wks.Range("a1") = myItem.Subject  ' need to have previously set worksheet object as above
        ' remove signature here
        myitem.save
        myitem.send
    without seeing sample, i can not code to remove signature
    i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
    Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next

    dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part

    come back and mark your original post as resolved if your problem is fixed
    pete

  3. #3

    Thread Starter
    Member
    Join Date
    Mar 2013
    Posts
    40

    Re: script: howto forward selected email using excel VBA

    Quote Originally Posted by westconn1 View Post
    try like
    Code:
        Set myItem = ActiveExplorer.Selection(1).Forward
        myItem.Subject = Replace(myItem.Subject, "Fwd:", "Grid:xxxxxxxx")
        Set r = myItem.Recipients.Add
        r.Name = "Me"
        r.AddressEntry = "me@myserver.com"
        wks.Range("a1") = myItem.Subject  ' need to have previously set worksheet object as above
        ' remove signature here
        myitem.save
        myitem.send
    without seeing sample, i can not code to remove signature
    thanks so far this is what the signature looks like
    Code:
    my name.
    
    my company
    
    my service
    
    adress
    
    NL:tel
    
    FR:+fax
    
    ENG:tel
    
    FAX:tel
    
    email
    
     
    
     
    
    -----Original Message-----
    
    From: original sender
    
     
    
     
    
     
    
    my name.
    
    my company
    
    my service
    
    adress
    
    NL:tel
    
    FR:+fax
    
    ENG:tel
    
    FAX:tel
    
    email
    
     
    
    From:Original sender

  4. #4
    PowerPoster
    Join Date
    Dec 2004
    Posts
    25,618

    Re: script: howto forward selected email using excel VBA

    you can try
    Code:
        myItem.HTMLBody = Mid(myItem.HTMLBody, InStr(myItem.HTMLBody, "-----Original Message-----"))
    i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
    Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next

    dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part

    come back and mark your original post as resolved if your problem is fixed
    pete

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width