adelgadoq
09-10-2014, 12:30 PM
Hello,
I want to make an autoforwarding macro, lets say i have so little VBA Experience that i use it as a modular set. We have multiple accounts (e.g, Secondary Adress,) working in an office, but all the comunications should be made using a unique Primary Adress. Browsing over the internet i manage to gather this code. But i cant retrieve the adress email from the mesagges body:
............................................Email body example...............................
"Please Send to: adress 1; adress 2
IMPORTANT TEXT
IMPORTANT TEXT
IMPORTANT TEXT
IMPORTANT TEXT
IMPORTANT TEXT
IMPORTANT TEXT
IMPORTANT TEXT
Email signature
-----------------------------------------------------------------------
I just need to resend the IMPORTANT TEXT, using the adresses on the first line.
Could somebody help me?
See the code below:
Sub SendNew(Item As Outlook.MailItem)
Dim Msg, Style, Title, Help, Ctxt, Response, MyString
Dim strName As String
Dim objMsg As MailItem
Set objMsg = Application.CreateItem(olMailItem)
strMsgBody = objMsg.Body
MsgBox strMsgBody
strEmailContents = ParseTextLinePair(strMsgBody, "Favor enviar a: ")
MsgBox strEmailContents
Msg = Item.Subject & " " & "a:"
Style = vbYesNo + vbCritical + vbDefaultButton2
Title = Item.Sender & " " & "desea enviar"
Help = "DEMO.HLP"
Ctxt = 1000
Response = MsgBox(Msg, Style, Title, Help, Ctxt)
If Response = vbNo Then
MsgBox "No Autorizado!"
Else
objMsg.Body = Item.Body
objMsg.Subject = "FW: " & Item.Subject
objMsg.Recipients.Add "adress x"
objMsg.Send
MsgBox "Enviado!"
End If
End Sub
Function ParseTextLinePair(strSource, strLabel)
' Sue Moshers code
'commented out type declaration for VBS usgage take out fer VB usage
Dim intLocLabel 'As Integer
Dim intLocCRLF 'As Integer
Dim intLenLabel 'As Integer
Dim strText 'As String
' locate the label in the source text
intLocLabel = InStr(strSource, strLabel)
intLenLabel = Len(strLabel)
If intLocLabel > 0 Then
intLocCRLF = InStr(intLocLabel, strSource, vbCrLf)
If intLocCRLF > 0 Then
intLocLabel = intLocLabel + intLenLabel
strText = Mid(strSource, _
intLocLabel, _
intLocCRLF - intLocLabel)
Else
intLocLabel = Mid(strSource, intLocLabel + intLenLabel)
End If
End If
ParseTextLinePair = Trim(strText) ' this i like
End Function
I want to make an autoforwarding macro, lets say i have so little VBA Experience that i use it as a modular set. We have multiple accounts (e.g, Secondary Adress,) working in an office, but all the comunications should be made using a unique Primary Adress. Browsing over the internet i manage to gather this code. But i cant retrieve the adress email from the mesagges body:
............................................Email body example...............................
"Please Send to: adress 1; adress 2
IMPORTANT TEXT
IMPORTANT TEXT
IMPORTANT TEXT
IMPORTANT TEXT
IMPORTANT TEXT
IMPORTANT TEXT
IMPORTANT TEXT
Email signature
-----------------------------------------------------------------------
I just need to resend the IMPORTANT TEXT, using the adresses on the first line.
Could somebody help me?
See the code below:
Sub SendNew(Item As Outlook.MailItem)
Dim Msg, Style, Title, Help, Ctxt, Response, MyString
Dim strName As String
Dim objMsg As MailItem
Set objMsg = Application.CreateItem(olMailItem)
strMsgBody = objMsg.Body
MsgBox strMsgBody
strEmailContents = ParseTextLinePair(strMsgBody, "Favor enviar a: ")
MsgBox strEmailContents
Msg = Item.Subject & " " & "a:"
Style = vbYesNo + vbCritical + vbDefaultButton2
Title = Item.Sender & " " & "desea enviar"
Help = "DEMO.HLP"
Ctxt = 1000
Response = MsgBox(Msg, Style, Title, Help, Ctxt)
If Response = vbNo Then
MsgBox "No Autorizado!"
Else
objMsg.Body = Item.Body
objMsg.Subject = "FW: " & Item.Subject
objMsg.Recipients.Add "adress x"
objMsg.Send
MsgBox "Enviado!"
End If
End Sub
Function ParseTextLinePair(strSource, strLabel)
' Sue Moshers code
'commented out type declaration for VBS usgage take out fer VB usage
Dim intLocLabel 'As Integer
Dim intLocCRLF 'As Integer
Dim intLenLabel 'As Integer
Dim strText 'As String
' locate the label in the source text
intLocLabel = InStr(strSource, strLabel)
intLenLabel = Len(strLabel)
If intLocLabel > 0 Then
intLocCRLF = InStr(intLocLabel, strSource, vbCrLf)
If intLocCRLF > 0 Then
intLocLabel = intLocLabel + intLenLabel
strText = Mid(strSource, _
intLocLabel, _
intLocCRLF - intLocLabel)
Else
intLocLabel = Mid(strSource, intLocLabel + intLenLabel)
End If
End If
ParseTextLinePair = Trim(strText) ' this i like
End Function