Script needed for replying to email address in body of receiving email

[FRS]

Basically, I need to reply to incoming emails. - The reply email address is in the body of the incoming email.

The reply email address would change for each email...... ( it will always be in the same location )

What I want to achieve is to automatically retrieve the email address from each email,,, and then reply with a pre-made email ( in drafts ) or setup an automatic template.

This is a sample of an incoming email. followed by the sample of the responding email.

In short I receive a notice from paypal when goods are purchased from my site.... and I need to send a conformation of received payment... and let them know that I have started production.

========================================================================================================================================

[TABLE="width: 580"]

[TR]

[TD="colspan: 3"][TABLE="width: 579"]

[TR]

[TD][/TD]

[/TR]

[TR]

[TD]

[/TD]

[/TR]

[TR]

[TD][/TD]

[/TR]

[/TABLE]

[/TD]

[/TR]

[TR]

[TD="colspan: 3"][/TD]

[/TR]

[TR]

[TD][/TD]

[TD][TABLE="width: 563"]

[TR]

[TD]You received a payment[/TD]

[TD]Transaction ID: 03K25099Y3093144G[/TD]

[/TR]

[/TABLE]

Dear Fast Rubber Stamps,

Thanks for using PayPal. To see all the transaction details, log in to your PayPal account.

See your invoice

It may take a few moments for this transaction to appear in your account.

[TABLE="width: 563, align: left"]

[TR]

[TD]Customer

Christopher Dale

scripttest@fastrubberstamps.com.au[/TD]

[TD]Note from customer

None[/TD]

[/TR]

[/TABLE]

[TABLE="width: 563, align: left"]

[TR]

[TD]Christopher Sale

PO Box 315 Rave

Grave, Victoria 3160

Australia[/TD]

[/TR]

[/TABLE]

[TABLE="width: 563, align: center"]

[TR]

[TD]Description[/TD]

[TD]Unit price[/TD]

[TD]Qty[/TD]

[TD]Amount[/TD]

[TD][/TD]

[/TR]

[TR]

[TD]Rubber Stamp Order[/TD]

[TD]$59.80[/TD]

[TD]1.000[/TD]

[TD]$59.80[/TD]

[TD][/TD]

[/TR]

[/TABLE]

[TABLE="width: 563, align: center"]

[TR]

[TD][TABLE="align: right"]

[TR]

[TD]Subtotal[/TD]

[TD]$59.80[/TD]

[TD][/TD]

[/TR]

[TR]

[TD]Shipping and handling[/TD]

[TD]$0.00[/TD]

[TD][/TD]

[/TR]

[TR]

[TD]GST 10%[/TD]

[TD]$5.44[/TD]

[TD][/TD]

[/TR]

[TR]

[TD]Total[/TD]

[TD="colspan: 2"]$59.80 AUD[/TD]

[/TR]

[/TABLE]

[/TD]

[/TR]

[TR]

[TD]Invoice ID 566[/TD]

[/TR]

[/TABLE]

Kind regards,

PayPal[/TD]

[TD][/TD]

[/TR]

[TR]

[TD="colspan: 3"][/TD]

[/TR]

[/TABLE]

[TABLE="width: 580"]

[TR]

[TD]Help Centre | Resolution Centre | Safety Advice

Copyright © 1999-2013 PayPal Australia Pty Limited ABN 93 111 195 389 (AFSL 304962). All rights reserved.

PayPal Email ID

=========================================================================================================================[/TD]

[/TR]

[/TABLE]

Thank you for your payment.

Your Fast Rubber Stamp order has now been processed and advanced to production.

Manufacture of your order will now commence, and will be completed ASAP.

You should expect delivery of your finished order within the next couple of days.

Thank you again for your order.

Production Dept

FRS

============================================================================================

Thank you in advance, for taking the time to review my requirements

FRS

 

[Diane Poremsky]

I'll delete the other post since they look to be duplicates - our best antispam filter is "new members + links = moderation" so this post got kicked into automatic moderation.

I have a macro or two that can do this -

http://www.slipstick.com/outlook/rules/send-a-new-message-when-a-message-arrives/

http://www.slipstick.com/developer/run-a-script-rule-autoreply-using-a-template/

They both work with rules to autoreply. To convert them to manual, change the sub name from this format:

Sub SendNew(Item As Outlook.MailItem)

to this:

Sub SendNew1()

Dim Item As Outlook.MailItem

Set Item = Application.ActiveExplorer.Selection.Item(1)

 

[FRS]

is this posting?

 

[FRS]

Thank you Dianne.

I managed to get this working. ( I've never done coding or scripting before ) But I have a Masters in "Copy & Paste"

Only problem I have is: That it is reply to the senders email address ( which is PayPal )

I need it to retrieve the email address from the body of the incoming email, and forward it to that

The email address will be different every time, but the incoming email is a generic PayPal template.

I can see where the problem is in the code..... but I have no idea how to fix it.

Here's what I have:

==========================================================================================

Sub SendNew(Item As Outlook.MailItem)

Dim objMsg As MailItem

Set objMsg = Application.CreateItemFromTemplate("C:\Documents and Settings\user\Application Data\Microsoft\Templates\FastRubberStampsProductionNotice.oft")

objMsg.Recipients.Add Item.SenderEmailAddress

' Copy the original message subject

objMsg.Subject = "PAYMENT RECEIVED - " & Item.Subject

objMsg.Send

End Sub

===================================================================================================================

Thanks in advance Geoff

 

[Diane Poremsky]

not a problem - you need to use little more code, like what is used in the sample here

use this as the pattern for an email address
With Reg1
.Pattern = "(([\w-\.]*\@[\w-\.]*)\s*)"
.IgnoreCase = True
.Global = False
End With

and so you don't need to set a reference to the scripting library, you could use these lines to replace the similar lines in the other:
Dim Reg1 As Object
Dim M1 As Object
Dim M As Object

Set Reg1 = CreateObject("VBScript.RegExp")

something like this - i didn't test it, so it might not be 100% correct.

Sub SendNew(Item As Outlook.MailItem)
  Dim Reg1 As Object
   Dim M1 As Object
   Dim M As Object
   Dim strAddress As String 
 
Set Reg1 = CreateObject("VBScript.RegExp")
   With Reg1
      .Pattern = "(([\w-\.]*\@[\w-\.]*)\s*)"
      .IgnoreCase = True
      .Global = False
   End With 
 
If Reg1.Test(Item.Body) Then
  
       Set M1 = Reg1.Execute(Item.Body)
       For Each M In M1
          strAddress = M.SubMatches(1)
       Next
   End If
Dim objMsg As MailItem
Set objMsg = Application.CreateItemFromTemplate("C:\Documents and Settings\user\Application Data\Microsoft\Templates\FastRubberStampsProductio nNotice.oft")
objMsg.Recipients.Add strAddress
' Copy the original message subject
objMsg.Subject = "PAYMENT RECEIVED - " & Item.Subject 
 
' use for testing
objMsg.display
' objMsg.Send
End Sub

 

[FRS]

Yep.... that works.....

Thank you very much.

On to the next project.

 

[FRS]

This was working yesterday ( with my test emails )

I did a reboot..... and now it won't work.

I have the script invoked within a rule in outlook.... all the other features within the same rule work..... email in... move to another folder... sound a wav file... show an alert... but then it doesnt show or forward the email.

I deleted the script and replaced it to no avail.

any suggestions?

does it have anything to do with the income email..... the email address contained within is a hyperlink as in... mailto:emailaddress@here,com ?????

cheers

Geoff

 

[Diane Poremsky]

What is your macro security set to? That is the usual cause of "it worked until i rebooted".

 

[FRS]

Macro Settings = Disable all macros without notifications

 

[Diane Poremsky]

Set it to enable all for testing, then sign it using selfcert and change the setting to allow signed macros. Instructions are at how to use vba editor

 

[FRS]

I still can't get it yo work... maybe something is wrong with my code

=================================================
Sub SendNew(Item As Outlook.MailItem)
Dim Reg1 As Object
Dim M1 As Object
Dim M As Object
Dim strAddress As String

Set Reg1 = CreateObject("VBScript.RegExp")
With Reg1
.Pattern = "(([\w-\.]*\@[\w-\.]*)\s*)"
.IgnoreCase = True
.Global = False
End With

If Reg1.Test(Item.Body) Then

Set M1 = Reg1.Execute(Item.Body)
For Each M In M1
strAddress = M.SubMatches(1)
Next
End If
Dim objMsg As MailItem
Set objMsg = Application.CreateItemFromTemplate("C:\Documents and Settings\user\Application Data\Microsoft\Templates\FastRubberStampsProductionNotice.oft")
objMsg.Recipients.Add strAddress
' Copy the original message subject
objMsg.Subject = "PAYMENT RECEIVED - " & Item.Subject

' use for testing
objMsg.Send
' objMsg.Send
End Sub

 

[FRS]

I think I got it to work...... it seems the rule was the problem... not the script.

In the rule I actioned: display a specific message in the NEW Item Alert window.

This worked... however, I think the process halted there.

Once I removed that action the script then ran.... sending my reply email.

So I guess I can't have every thing.

Thank you

 

[Diane Poremsky]

That was probably the problem - you shouldn't use actions with run a script, only conditions.

 

[scmilton1job]

Hi Diane,

I stumbled upon your Outlook auto-reply script months ago, and after tweaking it, it has worked the majority of the time. Occasionally it will fail with the following error:



How do I test to see what's causing the error?

This is what my script looks like:

'*************************************************

Sub RejectsAutoReply(Item As Outlook.MailItem)

Dim oRespond As Outlook.MailItem

Dim newSubject, newRecipients, nameRepair As String

Dim TestPos As Integer

'On Error GoTo Error_GoTo

' Use this for a real reply
'Set oRespond = Item.Reply
' Use this to forward
Set oRespond = Item.Forward

With oRespond
'.Recipients.Add Item.SenderEmailAddress
newSubject = Mid(.Subject, 5, 48)
newRecipients = Mid(.Subject, 53)

'put a space after every semicolon
newRecipients = Replace(newRecipients, ";", "; ")

'check to see if the new subject has "J.DS@XXX" in it. If it does and is not fixed, the email cannot be sent
TestPos = InStr(newRecipients, "J.DS@XXX")

'If newSubject contains J.DS@XXX,
If TestPos > 0 Then

'replace it with J.DS@XXXXX.com
newRecipients = Replace(newRecipients, "J.DS@XXX", "J.DS@XXXXX.com")
End If

.Recipients.Add (newRecipients)
.Recipients.ResolveAll
.Subject = newSubject
.Body = Item.Body

' includes the original message as an attachment

' .Attachments.Add Item

' use this for testing, change to .send once you have it working as desired
.Display
Pause (5)
.Send

End With
oRespond.UnRead = False
Set oRespond = Nothing

End Sub

'**************************************************

Public Function Pause(NumberOfSeconds As Variant)
On Error GoTo Error_GoTo
Dim PauseTime As Variant
Dim Start As Variant
Dim Elapsed As Variant
PauseTime = NumberOfSeconds
Start = Timer
Elapsed = 0
Do While Timer < Start + PauseTime
Elapsed = Elapsed + 1
If Timer = 0 Then
' Crossing midnight
PauseTime = PauseTime - Elapsed
Start = 0
Elapsed = 0
End If
DoEvents
Loop

Exit_GoTo:
On Error GoTo 0
Exit Function

Error_GoTo:
Debug.Print Err.Number, Err.Description, Erl
GoTo Exit_GoTo

End Function

'*********

Thank you again,

Shawn

 

[Diane Poremsky]

I don't think there is anything wrong with the code, especially if it works most of the time. I have some macros that fail too and it just something with the rules engine - I know if you get mail in too fast, it will fail. It might be better to convert it to an ItemAdd macro or even NewMailEx.

What rules are you using to control what messages are touched by the script?

 

[daddymackdc]

First off let me say you are awesome. I started out today like "I have to learn vbscript now?!" In less then two hours your script got me going home early so thanks much.

Would you have any idea why my script produces the email in a new window totally filled out, but dosent send it? I have to manually hit send. And as i am not always here, it would be difficult. Your help is much appreciated, Thanks!

 

[Diane Poremsky]

This is supposed to handle the send:
' use this for testing, change to .send once you have it working as desired
.Display
Pause (5)
.Send
End With

try removing the pause and display lines.

 

[FRS]

Diane - I'm back.

I see this forum has had some activity whilst I've been away.

I need some help please.

I have no idea what I'm doing - but you got me thru last time... so you are my guru.

Basically I want to auto reply to an email, by pulling the reply address out of the body of an email by running a script. ( which is what you setup for me last time ).

and reply with a outlook template. ( I have already created the template FastRubberStampsOrderNotice.oft

I'm not sure whether I add to the existing script or do I start a new second script ?

I can open VB and see my previous script on the screen. but I cant see where to make a new script.

I've pasted this out of the existing script you did for me ( that works perfectly ) RED IS THE NEW INFORMATION I WOULD NEED

============================================================================================================================

Dim objMsg As MailItem
Set objMsg = Application.CreateItemFromTemplate("C:\Documents and Settings\user\Application Data\Microsoft\Templates\FastRubberStampsOrderNotice.oft")
objMsg.Recipients.Add strAddress
' Copy the original message subject
objMsg.Subject = "ORDER MSG SENT - " & Item.Subject

======================================================================================================================

Below - THIS IS THE EXISTING WORKING SCRIPT for your viewing ( Entire Script )- FRSPAID

===================================================================================================

Sub SendNew(Item As Outlook.MailItem)
Dim Reg1 As Object
Dim M1 As Object
Dim M As Object
Dim strAddress As String

Set Reg1 = CreateObject("VBScript.RegExp")
With Reg1
.Pattern = "(([\w-\.]*\@[\w-\.]*)\s*)"
.IgnoreCase = True
.Global = False
End With

If Reg1.Test(Item.Body) Then

Set M1 = Reg1.Execute(Item.Body)
For Each M In M1
strAddress = M.SubMatches(1)
Next
End If
Dim objMsg As MailItem
Set objMsg = Application.CreateItemFromTemplate("C:\Documents and Settings\user\Application Data\Microsoft\Templates\FastRubberStampsProductionNotice.oft")
objMsg.Recipients.Add strAddress
' Copy the original message subject
objMsg.Subject = "PAYMENT RECEIVED - " & Item.Subject

' use for testing
objMsg.Send
' objMsg.Send
End Sub

=======================================================================================

I hope I make sense - Thank you in advanced

(I'f I do need a second script -I would call it "FRSORDER"

 

[Diane Poremsky]

Because you are working with basically the same thing, you just need to make a copy of the script and replace those two values.

Use .display for testing

' use for testing
objMsg.Send

- - - Updated - - -

Because you are working with basically the same thing, you just need to make a copy of the script and replace those two values.




Use .display for testing


' use for testing
objMsg.Send

 

[FRS]

Because you are working with basically the same thing, you just need to make a copy of the script and replace those two values.

Use .display for testing

' use for testing
objMsg.Send

- - - Updated - - -

Because you are working with basically the same thing, you just need to make a copy of the script and replace those two values.

Use .display for testing

' use for testing
objMsg.Send

Great - Sounds easy....... From inside VB I cant find a 'save as" option.

And I'm not sure where the script file is kept.

If I could find it... I'm capable of editing and renaming.

I'm sorry to sound so dumb.....