-
Mar 17th, 2014, 01:12 AM
#1
Thread Starter
Member
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
-
Mar 17th, 2014, 06:42 AM
#2
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
-
Mar 17th, 2014, 08:13 AM
#3
Thread Starter
Member
Re: script: howto forward selected email using excel VBA
Originally Posted by westconn1
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
-
Mar 17th, 2014, 02:56 PM
#4
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
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|