Solved

BlueDevilFan script need a change to send reply all which are selected.

Posted on 2008-11-02
30
412 Views
Last Modified: 2012-05-05
Hi,

BlueDevilFan script need a change to send reply all which are selected.

I want the body of the mail as this

Hi (Sender name just the first name) if the sender name is "Sharath fty" i should get just "Sharath"

Some data

Regards
Sharath

Can these above be added to the script.

Regards
sharath

Sub ReplyToAllSelected()

    Const REPLY_TEXT = "Thanks the data has been updated."

    Dim olkMsg As Object, _

        olkReply As Object

    For Each olkMsg In Application.ActiveExplorer.Selection

        Set olkReply = olkMsg.Reply

        If olkReply.BodyFormat = olFormatHTML Then

            olkReply.HTMLBody = REPLY_TEXT & "<br><br>" & olkReply.HTMLBody

        Else

            olkReply.Body = REPLY_TEXT & vbCrLf & vbCrLf & olkReply.Body

        End If

        olkReply.Send

    Next

    Set olkMsg = Nothing

    Set olkReply = Nothing

    MsgBox "All done!", vbInformation + vbOKOnly, "Reply to All Selected"

End Sub

Open in new window

0
Comment
Question by:bsharath
  • 18
  • 12
30 Comments
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 22860919
Not 100% sure what you want but see how close this gets.

Chris
Sub ReplyToAllSelected()

    Const REPLY_TEXT = "Thanks the data has been updated."

    Dim olkMsg As Object, _

        olkReply As Object

    For Each olkMsg In Application.ActiveExplorer.Selection

        Set olkReply = olkMsg.reply

        If olkReply.BodyFormat = olFormatHTML Then

            olkReply.HTMLBody = " Hi " & _

                IIf(IsError(olkMsg.SenderName), "", Left(olkMsg.SenderName, InStr(olkMsg, " ") - 1)) & "<br><br>" & _

                REPLY_TEXT & "<br><br>" & olkReply.HTMLBody

        Else

            olkReply.Body = " Hi " & _

                IIf(IsError(olkMsg.SenderName), "", Left(olkMsg.SenderName, InStr(olkMsg, " ") - 1)) & vbCrLf & vbCrLf & _

            REPLY_TEXT & vbCrLf & vbCrLf & olkReply.Body

        End If

        olkReply.Display

    Next

    Set olkMsg = Nothing

    Set olkReply = Nothing

    MsgBox "All done!", vbInformation + vbOKOnly, "Reply to All Selected"

End Sub

Open in new window

0
 
LVL 11

Author Comment

by:bsharath
ID: 22860925
Hi Chris it the right thing but get this

Hi Shar

Thanks the data has been updated.

I need it to be as this

Hi Shar ( The Name has to be the first name) You previously gave me the solution for fetching the first name and placing it next to hi

Thanks the data has been updated.

Regards
Sharath
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 22860951
DO you want to look the first name up from the ADS?

I am assuming at the moment that Sharath fty is not what is stored asd the sender name rather "Shat fty"?

Chris
0
 
LVL 11

Author Comment

by:bsharath
ID: 22860969
Yes from ADS the Ntlogin minus the last letter.

My NTlogin is
Sharathw
i want just "Sharath" to be placed.



0
 
LVL 11

Author Comment

by:bsharath
ID: 22860987
Chris here you gave me the solution to this...
http://www.experts-exchange.com/Software/Office_Productivity/Groupware/Outlook/Q_23735971.html
See if you can add the same to this...
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 22860993
From what I recall of the syntax at the time try this.

Chris
Option Explicit
 

Sub ReplyToAllSelected()

Dim strSender As String

    Const REPLY_TEXT = "Thanks the data has been updated."

    Dim olkMsg As Object, _

        olkReply As Object

    For Each olkMsg In Application.ActiveExplorer.Selection

        Set olkReply = olkMsg.reply

        strSender = GetSMTPAddress(olkMsg.SenderName)

        If olkReply.BodyFormat = olFormatHTML Then

            olkReply.HTMLBody = " Hi " & _

                IIf(IsError(strSender), "", Left(strSender, InStr(olkMsg, " ") - 1)) & "<br><br>" & _

                REPLY_TEXT & "<br><br>" & olkReply.HTMLBody

        Else

            olkReply.Body = " Hi " & _

                IIf(IsError(olkMsg.strSender), "", Left(strSender, InStr(olkMsg, " ") - 1)) & vbCrLf & vbCrLf & _

            REPLY_TEXT & vbCrLf & vbCrLf & olkReply.Body

        End If

        olkReply.Display

    Next

    Set olkMsg = Nothing

    Set olkReply = Nothing

    MsgBox "All done!", vbInformation + vbOKOnly, "Reply to All Selected"

End Sub
 

Function GetSMTPAddress(ByVal strAddress As String)

' As supplied by Vikas Verma ... see

' http://blogs.msdn.com/vikas/archive/2007/10/24/oom-getting-primary-smtp-address-from-x400-x500-sip-ccmail-etc.aspx

Dim olapp As Object

Dim oCon As Object

Dim strKey As String

Dim oRec As Object

Dim strRet As String

Dim fldr As Object

    'IF OUTLOOK VERSION IS >= 2007 THEN USES NATIVE OOM PROPERTIES AND METHODS

    On Error Resume Next

    Set olapp = Application

    Set fldr = olapp.GetNamespace("MAPI").GetDefaultFolder(10).folders.Item("Random")

    If fldr Is Nothing Then

        olapp.GetNamespace("MAPI").GetDefaultFolder(10).folders.Add "Random"

        Set fldr = olapp.GetNamespace("MAPI").GetDefaultFolder(10).folders.Item("Random")

    End If

    On Error GoTo 0

    If CInt(Left(olapp.Version, 2)) >= 12 Then

        Set oRec = olapp.Session.CreateRecipient(strAddress)

        If oRec.Resolve Then

            strRet = oRec.AddressEntry.GetExchangeUser.PrimarySmtpAddress

        End If

    End If

    If Not strRet = "" Then GoTo ReturnValue

    'IF OUTLOOK VERSION IS < 2007 THEN USES LITTLE HACK

    'How it works

    '============

    '1) It will create a new contact item

    '2) Set it's email address to the value passed by you, it could be X500,X400 or any type of email address stored in the AD

    '3) We will assign a random key to this contact item and save it in its Fullname to search it later

    '4) Next we will save it to local contacts folder

    '5) Outlook will try to resolve the email address & make AD call if required else take the Primary SMTP address from its cache and append it to Display name

    '6) The display name will be something like this " ( email.address@server.com )"

    '7) Now we need to parse the Display name and delete the contact from contacts folder

    '8) Once the contact is deleted it will go to Deleted Items folder, after searching the contact using the unique random key generated in step 3

    '9) We then need to delete it from Deleted Items folder as well, to clean all the traces

    Set oCon = fldr.Items.Add(2)

    oCon.Email1Address = strAddress

    strKey = "_" & Replace(Rnd * 100000 & Format(Now, "DDMMYYYYHmmss"), ".", "")

    oCon.FullName = strKey

    oCon.Save

    strRet = Trim(Replace(Replace(Replace(oCon.Email1DisplayName, "(", ""), ")", ""), strKey, ""))

    oCon.Delete

    Set oCon = Nothing

    Set oCon = olapp.Session.GetDefaultFolder(3).Items.Find("[Subject]=" & strKey)

    If Not oCon Is Nothing Then oCon.Delete

ReturnValue:

    GetSMTPAddress = strRet

End Function

Open in new window

0
 
LVL 11

Author Comment

by:bsharath
ID: 22861007
Still just get half my name...
And dont get the  footer
Regards
Sharath
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 22861182
look at the footer in a mo.

Still only get 1/2 your name:

From the earler question the sample returns from the function are:

sharathyu@plc.com
kankrishnan@plc.com

Leading to first names you want to use as:

sharathy
kankrishna

Is that correct

Chris
0
 
LVL 11

Author Comment

by:bsharath
ID: 22861202
I want just
sharath
out of this
sharathyu@plc.com
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 22861261
Thats what I thought but the problem is what to do in other cases:

kankrishnan@plc.com less two characters = kankrishn

How can we identify the correct firstname from the email address reliably ... or can we?

Chris
0
 
LVL 11

Author Comment

by:bsharath
ID: 22861305
Everyone will have a first name and last name in the email aaddress.
in one case we can just get first name

The other way is the solution you gave me in the above post minus last letter. Any of these 2 ways are fine...
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 22863362
As far as I can see the referenced question had different data being returned.

Somehow we need to establish what is available and a pattern to process it.  My initial post returned for yourself:

"Hi Shar".  I suspect an error here that can be retrieved!  first off see what is returned without any shenanigans!  Let me know if you can.

Chris
Sub ReplyToAllSelected2()

Dim strSender As String

    Const REPLY_TEXT = "Thanks the data has been updated."

    Dim olkMsg As Object, _

        olkReply As Object

    For Each olkMsg In Application.ActiveExplorer.Selection

        Set olkReply = olkMsg.reply

        If olkReply.BodyFormat = olFormatHTML Then

            olkReply.HTMLBody = " Hi " & _

                olkMsg.SenderName & " | " & olkMsg.SenderEmailAddress & _

                "<br><br>" & _

                REPLY_TEXT & "<br>" & olkReply.HTMLBody

        Else

            olkReply.Body = " Hi " & _

            olkReply.HTMLBody = " Hi " & _

                olkMsg.SenderName & " | " & olkMsg.SenderEmailAddress & _

                vbCrLf & vbCrLf & _

            REPLY_TEXT & vbCrLf & vbCrLf & olkReply.Body

        End If

        olkReply.Display

    Next

    Set olkMsg = Nothing

    Set olkReply = Nothing

    MsgBox "All done!", vbInformation + vbOKOnly, "Reply to All Selected"

End Sub

Open in new window

0
 
LVL 11

Author Comment

by:bsharath
ID: 22864647
I get this

Hi Viya Srisan | /O=GROUP/OU=FIRST ADMINISTRATIVE GROUP/CN=RECIPIENTS/CN=VIYAS

Thanks the data has been updated.
0
 
LVL 11

Author Comment

by:bsharath
ID: 22864648
I get this

Hi Viya Srisan | /O=GROUP/OU=FIRST ADMINISTRATIVE GROUP/CN=RECIPIENTS/CN=VIYAS

Thanks the data has been updated.
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 22864906
Apologies since I don't know the format for your organisation:

Is Viya or Srisan the name you want displayed ... and is it reliably returned as therequired name for a number of users, (i.e. yourself included?)

Chris
0
3 Use Cases for Connected Systems

Our Dev teams are like yours. They’re continually cranking out code for new features/bugs fixes, testing, deploying, testing some more, responding to production monitoring events and more. It’s complex. So, we thought you’d like to see what’s working for us.

 
LVL 11

Author Comment

by:bsharath
ID: 22864914
Viya Srisan is the full name
I just want Viya to comer next to "Hi"

The code below just works perfect to forward mails into drafts and pick just the first name removing the last letter also.

If the same can be got into this.That would be great...

I just used this code 5 min back also... :-))
Sub Sophos_Filter_And_Send_To_Drafts()

 

Dim olfolder As MAPIFolder

Dim mai As Outlook.MailItem

Dim mySubjects() As String

Dim findobj As Object

Dim strSubject As String

Dim strfilter As String

Dim folderItems As Items

Dim SortedItems As Items

Dim objitem As Object

Dim objCount As Long

Dim maicount As Integer

Dim tmp As Integer

Dim strtemp As String

Dim usr As String

Dim usrArray() As String

Dim usrExists As Boolean

Dim usrcount As Integer

Dim usrtemp As String

 

    Set olfolder = Application.GetNamespace("MAPI").PickFolder

    Set folderItems = olfolder.Items

    folderItems.SetColumns "Subject, ReceivedTime"

    folderItems.Sort "Subject", False

    Set SortedItems = folderItems

    ReDim mySubjects(1)

    For objCount = 1 To SortedItems.Count

        If mySubjects(UBound(mySubjects) - 1) <> SortedItems.Item(objCount).Subject And LCase(Left(SortedItems.Item(objCount).Subject, 3)) <> "re:" And LCase(Left(SortedItems.Item(objCount).Subject, 3)) <> "fw:" And LCase(Left(SortedItems.Item(objCount).Subject, 4)) <> "ref:" Then

            mySubjects(UBound(mySubjects)) = SortedItems.Item(objCount).Subject

            ReDim Preserve mySubjects(UBound(mySubjects) + 1)

        ElseIf LCase(Left(SortedItems.Item(objCount).Subject, 4)) = "re: " And mySubjects(UBound(mySubjects) - 1) <> Right(SortedItems.Item(objCount).Subject, Len(SortedItems.Item(objCount).Subject) - 4) Then

            mySubjects(UBound(mySubjects)) = Right(SortedItems.Item(objCount).Subject, Len(SortedItems.Item(objCount).Subject) - 4)

            ReDim Preserve mySubjects(UBound(mySubjects) + 1)

        ElseIf LCase(Left(SortedItems.Item(objCount).Subject, 4)) = "fw: " And mySubjects(UBound(mySubjects) - 1) <> Right(SortedItems.Item(objCount).Subject, Len(SortedItems.Item(objCount).Subject) - 4) Then

            mySubjects(UBound(mySubjects)) = Right(SortedItems.Item(objCount).Subject, Len(SortedItems.Item(objCount).Subject) - 4)

            ReDim Preserve mySubjects(UBound(mySubjects) + 1)

        ElseIf LCase(Left(SortedItems.Item(objCount).Subject, 5)) = "ref: " And mySubjects(UBound(mySubjects) - 1) <> Right(SortedItems.Item(objCount).Subject, Len(SortedItems.Item(objCount).Subject) - 5) Then

            mySubjects(UBound(mySubjects)) = Right(SortedItems.Item(objCount).Subject, Len(SortedItems.Item(objCount).Subject) - 5)

            ReDim Preserve mySubjects(UBound(mySubjects) + 1)

        End If

    Next

    ReDim Preserve mySubjects(UBound(mySubjects) - 1)

    For objCount = 1 To UBound(mySubjects)

        usr = ""

        strSubject = mySubjects(objCount)

        If InStr(strSubject, "[") = 0 And InStr(strSubject, "]") = 0 Then

            strfilter = "[Subject] = '" & cleanstr(strSubject) & "'"

            Set findobj = olfolder.Items.Restrict(strfilter)

            If findobj.Count <> 0 Then

                ' Create the holding email

                Set mai = Application.CreateItem(olMailItem)

                If findobj.Count > 10 Then

                    tmp = 10

                Else

                    tmp = findobj.Count

                End If

                strtemp = ""

                For maicount = 1 To tmp

                    usrArray = Split(findobj.Item(maicount).Body, "User: DEVELOPMENT\")

                    usrExists = CBool(UBound(usrArray) = 1)

                    If usrExists Then

                        usrcount = InStr(usrArray(1), " ")

                        If InStr(usrArray(1), vbCr) < usrcount Then usrcount = InStr(usrArray(1), vbCr)

                        If InStr(usrArray(1), vbLf) < usrcount Then usrcount = InStr(usrArray(1), vbLf)

                        usrtemp = Mid(findobj.Item(maicount).Body, InStr(findobj.Item(maicount).Body, "User: DEVELOPMENT\") + 18, usrcount - 1)

                        If InStr(usr, usrtemp) = 0 Then _

                            usr = usr & usrtemp & "; "

                    End If

                    mai.Attachments.Add findobj.Item(maicount)

                    If findobj.Item(maicount).Class = olMail Then

                        If InStr(LCase(strtemp), LCase(findobj.Item(maicount).SenderEmailAddress)) = 0 Then _

                            strtemp = strtemp & findobj.Item(maicount).SenderEmailAddress & "; "

                    End If

                Next

    '            mai.To = Left(strtemp, Len(strtemp) - 2)

                mai.Subject = "Virus Alert (Action Required)"

                mai.Save

                If usr = "" Then

                    mai.Body = "Hi," & vbCrLf & vbCrLf

                Else

                    mai.To = Left(usr, Len(usr) - 2)

                     mai.Body = "Hi " & DelChar(usr) & vbCrLf & vbCrLf

                End If

                mai.Body = mai.Body & "Please check the attached mails for the paths where virus/Trojans are detected and clear them by deleting. After which run a full system scan. Reply back with the results." & vbCrLf

                mai.Body = mai.Body & "If you have any issues while deleting the files. Please Raise a call log with GSD by calling 4567." & vbCrLf & vbCrLf & vbCrLf

                mai.Body = mai.Body & "Regards" & vbCrLf

                mai.Body = mai.Body & "Sharath (8888)"

                mai.Save

            Else

                Debug.Print strSubject

            End If

        End If

    Next

        

 

End Sub

 

Function cleanstr(str As String) As String

    cleanstr = Replace(str, "'", "''")

End Function
 

Function DelChar(str As String) As String

Dim regEx As RegExp     ' Microsoft VB Script Regular Expressions Type Library

        

  Set regEx = New RegExp

  regEx.IgnoreCase = True

  regEx.Global = True

 

    regEx.Pattern = "([a-zA-Z0-9]+)([a-zA-Z0-9];)"

    DelChar = regEx.Replace(str, "$1, ")

    regEx.Pattern = "([a-zA-Z0-9]+)([a-zA-Z0-9]$)"

    DelChar = regEx.Replace(DelChar, "$1")

    

 

  Set regEx = Nothing

End Function

Open in new window

0
 
LVL 11

Author Comment

by:bsharath
ID: 22864915
Viya Srisan is the full name
I just want Viya to comer next to "Hi"

The code below just works perfect to forward mails into drafts and pick just the first name removing the last letter also.

If the same can be got into this.That would be great...

I just used this code 5 min back also... :-))
Sub Sophos_Filter_And_Send_To_Drafts()

 

Dim olfolder As MAPIFolder

Dim mai As Outlook.MailItem

Dim mySubjects() As String

Dim findobj As Object

Dim strSubject As String

Dim strfilter As String

Dim folderItems As Items

Dim SortedItems As Items

Dim objitem As Object

Dim objCount As Long

Dim maicount As Integer

Dim tmp As Integer

Dim strtemp As String

Dim usr As String

Dim usrArray() As String

Dim usrExists As Boolean

Dim usrcount As Integer

Dim usrtemp As String

 

    Set olfolder = Application.GetNamespace("MAPI").PickFolder

    Set folderItems = olfolder.Items

    folderItems.SetColumns "Subject, ReceivedTime"

    folderItems.Sort "Subject", False

    Set SortedItems = folderItems

    ReDim mySubjects(1)

    For objCount = 1 To SortedItems.Count

        If mySubjects(UBound(mySubjects) - 1) <> SortedItems.Item(objCount).Subject And LCase(Left(SortedItems.Item(objCount).Subject, 3)) <> "re:" And LCase(Left(SortedItems.Item(objCount).Subject, 3)) <> "fw:" And LCase(Left(SortedItems.Item(objCount).Subject, 4)) <> "ref:" Then

            mySubjects(UBound(mySubjects)) = SortedItems.Item(objCount).Subject

            ReDim Preserve mySubjects(UBound(mySubjects) + 1)

        ElseIf LCase(Left(SortedItems.Item(objCount).Subject, 4)) = "re: " And mySubjects(UBound(mySubjects) - 1) <> Right(SortedItems.Item(objCount).Subject, Len(SortedItems.Item(objCount).Subject) - 4) Then

            mySubjects(UBound(mySubjects)) = Right(SortedItems.Item(objCount).Subject, Len(SortedItems.Item(objCount).Subject) - 4)

            ReDim Preserve mySubjects(UBound(mySubjects) + 1)

        ElseIf LCase(Left(SortedItems.Item(objCount).Subject, 4)) = "fw: " And mySubjects(UBound(mySubjects) - 1) <> Right(SortedItems.Item(objCount).Subject, Len(SortedItems.Item(objCount).Subject) - 4) Then

            mySubjects(UBound(mySubjects)) = Right(SortedItems.Item(objCount).Subject, Len(SortedItems.Item(objCount).Subject) - 4)

            ReDim Preserve mySubjects(UBound(mySubjects) + 1)

        ElseIf LCase(Left(SortedItems.Item(objCount).Subject, 5)) = "ref: " And mySubjects(UBound(mySubjects) - 1) <> Right(SortedItems.Item(objCount).Subject, Len(SortedItems.Item(objCount).Subject) - 5) Then

            mySubjects(UBound(mySubjects)) = Right(SortedItems.Item(objCount).Subject, Len(SortedItems.Item(objCount).Subject) - 5)

            ReDim Preserve mySubjects(UBound(mySubjects) + 1)

        End If

    Next

    ReDim Preserve mySubjects(UBound(mySubjects) - 1)

    For objCount = 1 To UBound(mySubjects)

        usr = ""

        strSubject = mySubjects(objCount)

        If InStr(strSubject, "[") = 0 And InStr(strSubject, "]") = 0 Then

            strfilter = "[Subject] = '" & cleanstr(strSubject) & "'"

            Set findobj = olfolder.Items.Restrict(strfilter)

            If findobj.Count <> 0 Then

                ' Create the holding email

                Set mai = Application.CreateItem(olMailItem)

                If findobj.Count > 10 Then

                    tmp = 10

                Else

                    tmp = findobj.Count

                End If

                strtemp = ""

                For maicount = 1 To tmp

                    usrArray = Split(findobj.Item(maicount).Body, "User: DEVELOPMENT\")

                    usrExists = CBool(UBound(usrArray) = 1)

                    If usrExists Then

                        usrcount = InStr(usrArray(1), " ")

                        If InStr(usrArray(1), vbCr) < usrcount Then usrcount = InStr(usrArray(1), vbCr)

                        If InStr(usrArray(1), vbLf) < usrcount Then usrcount = InStr(usrArray(1), vbLf)

                        usrtemp = Mid(findobj.Item(maicount).Body, InStr(findobj.Item(maicount).Body, "User: DEVELOPMENT\") + 18, usrcount - 1)

                        If InStr(usr, usrtemp) = 0 Then _

                            usr = usr & usrtemp & "; "

                    End If

                    mai.Attachments.Add findobj.Item(maicount)

                    If findobj.Item(maicount).Class = olMail Then

                        If InStr(LCase(strtemp), LCase(findobj.Item(maicount).SenderEmailAddress)) = 0 Then _

                            strtemp = strtemp & findobj.Item(maicount).SenderEmailAddress & "; "

                    End If

                Next

    '            mai.To = Left(strtemp, Len(strtemp) - 2)

                mai.Subject = "Virus Alert (Action Required)"

                mai.Save

                If usr = "" Then

                    mai.Body = "Hi," & vbCrLf & vbCrLf

                Else

                    mai.To = Left(usr, Len(usr) - 2)

                     mai.Body = "Hi " & DelChar(usr) & vbCrLf & vbCrLf

                End If

                mai.Body = mai.Body & "Please check the attached mails for the paths where virus/Trojans are detected and clear them by deleting. After which run a full system scan. Reply back with the results." & vbCrLf

                mai.Body = mai.Body & "If you have any issues while deleting the files. Please Raise a call log with GSD by calling 4567." & vbCrLf & vbCrLf & vbCrLf

                mai.Body = mai.Body & "Regards" & vbCrLf

                mai.Body = mai.Body & "Sharath (8888)"

                mai.Save

            Else

                Debug.Print strSubject

            End If

        End If

    Next

        

 

End Sub

 

Function cleanstr(str As String) As String

    cleanstr = Replace(str, "'", "''")

End Function
 

Function DelChar(str As String) As String

Dim regEx As RegExp     ' Microsoft VB Script Regular Expressions Type Library

        

  Set regEx = New RegExp

  regEx.IgnoreCase = True

  regEx.Global = True

 

    regEx.Pattern = "([a-zA-Z0-9]+)([a-zA-Z0-9];)"

    DelChar = regEx.Replace(str, "$1, ")

    regEx.Pattern = "([a-zA-Z0-9]+)([a-zA-Z0-9]$)"

    DelChar = regEx.Replace(DelChar, "$1")

    

 

  Set regEx = Nothing

End Function

Open in new window

0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 22864970
If I understand corrrectly then please try the following.

Chris
Sub ReplyToAllSelected2()

Dim strSender As String

    Const REPLY_TEXT = "Thanks the data has been updated."

    Dim olkMsg As Object, _

        olkReply As Object

    For Each olkMsg In Application.ActiveExplorer.Selection

        Set olkReply = olkMsg.reply

        strSender = left(olkMsg.SenderName, instr(olkMsg.SenderName, " "))

        If olkReply.BodyFormat = olFormatHTML Then

            olkReply.HTMLBody = " Hi " & strSender & _

                "<br><br>" & _

                REPLY_TEXT & "<br>" & olkReply.HTMLBody

        Else

            olkReply.Body = " Hi " & strSender & _

                vbCrLf & vbCrLf & _

            REPLY_TEXT & vbCrLf & vbCrLf & olkReply.Body

        End If

        olkReply.Send

    Next

    Set olkMsg = Nothing

    Set olkReply = Nothing

    MsgBox "All done!", vbInformation + vbOKOnly, "Reply to All Selected"

End Sub

Open in new window

0
 
LVL 11

Author Comment

by:bsharath
ID: 22864975
Exactly what i wanted...

But want them saved in the drafts folder or need them in a opened state so i can verify and send them.

The footer after this line
Thanks the data has been updated.
I want this

Regards
Sharath
0
 
LVL 11

Author Comment

by:bsharath
ID: 22864976
Exactly what i wanted...

But want them saved in the drafts folder or need them in a opened state so i can verify and send them.

The footer after this line
Thanks the data has been updated.
I want this

Regards
Sharath
0
 
LVL 59

Accepted Solution

by:
Chris Bottomley earned 500 total points
ID: 22864992
Changed to display for approval. and hopefully formatted the regards correctly.

Chris


Sub ReplyToAllSelected2()

Dim strSender As String

    Const REPLY_TEXT = "Thanks the data has been updated."

    Dim olkMsg As Object, _

        olkReply As Object

    For Each olkMsg In Application.ActiveExplorer.Selection

        Set olkReply = olkMsg.reply

        strSender = left(olkMsg.SenderName, instr(olkMsg.SenderName, " "))

        If olkReply.BodyFormat = olFormatHTML Then

            olkReply.HTMLBody = " Hi " & strSender & _

                "<br><br>" & _

                REPLY_TEXT & "<br><br>" & _

                "Regards" & "<br>" & "Sharath" & _

                "<br><br>" & olkReply.HTMLBody

        Else

            olkReply.Body = " Hi " & strSender & _

                vbCrLf & vbCrLf & _

                REPLY_TEXT & vbCrLf & vbCrLf & _

                "Regards" & vbcrlf & "Sharath" & _

            vbCrLf & vbCrLf & olkReply.Body

        End If

        olkReply.display

    Next

    Set olkMsg = Nothing

    Set olkReply = Nothing

    MsgBox "All done!", vbInformation + vbOKOnly, "Reply to All Selected"

End Sub

Open in new window

0
 
LVL 11

Author Comment

by:bsharath
ID: 22865001
Its perfect...

Can i have the font type and size same.
As i get Hi and name in one font and the rest in another
0
 
LVL 11

Author Comment

by:bsharath
ID: 22865002
Its perfect...

Can i have the font type and size same.
As i get Hi and name in one font and the rest in another
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 22865031
Not sure ... in the background I was just playing with the HTML formatting out of self interest and not getting anywhere yet.

I presume you are talking HTML mails ... and in my tests the added text all comes out the same.

Any extra guidance would therefore be appreciated.

Chris
0
 
LVL 11

Author Comment

by:bsharath
ID: 22865039
No problem thats not a big issue.

Thank U...

Can you look at the other post i commented yesterday for the same addition please...
0
 
LVL 11

Author Comment

by:bsharath
ID: 22865040
No problem thats not a big issue.

Thank U...

Can you look at the other post i commented yesterday for the same addition please...
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 22865121
> Can you look at the other post i commented yesterday for the same addition please

Apologies but can you directg me to the correct Q please?

Chris
0
 
LVL 11

Author Comment

by:bsharath
ID: 22865144
0
 
LVL 11

Author Comment

by:bsharath
ID: 22865147
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 22865237
http://www.experts-exchange.com/Software/Office_Productivity/Groupware/Outlook/Q_23690871.html
Comment posted therein

http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Excel/Q_23868559.html
I agree with Pari, let them know how source and target ranges are identified ... i.e. using a macro it will be easiest for you if the two ranges can be hard coded.

http://www.experts-exchange.com/Software/Office_Productivity/Groupware/Outlook/Q_23858586.html
I will investigate a response before posting therein

Chris
0

Featured Post

Zoho SalesIQ

Hassle-free live chat software re-imagined for business growth. 2 users, always free.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Sometimes Outlook might have problems sending a message. There may be various causes- corrupted PST, AV scanner etc. The message, instead of going to the Sent Items folder, sits in the Outbox indefinitely. To remove it you can use a free tool cal…
Is your Office 365 signature not working the way you want it to? Are signature updates taking up too much of your time? Let's run through the most common problems that an IT administrator can encounter when dealing with Office 365 email signatures.
The viewer will learn how to create and use a small PHP class to apply a watermark to an image. This video shows the viewer the setup for the PHP watermark as well as important coding language. Continue to Part 2 to learn the core code used in creat…
To add imagery to an HTML email signature, you have two options available to you. You can either add a logo/image by embedding it directly into the signature or hosting it externally and linking to it. The vast majority of email clients display l…

910 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

23 Experts available now in Live!

Get 1:1 Help Now