Solved

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

Posted on 2008-11-02
30
409 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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
Still just get half my name...
And dont get the  footer
Regards
Sharath
0
 
LVL 59

Expert Comment

by:Chris Bottomley
Comment Utility
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
Comment Utility
I want just
sharath
out of this
sharathyu@plc.com
0
 
LVL 59

Expert Comment

by:Chris Bottomley
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

 
LVL 11

Author Comment

by:bsharath
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
> 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
Comment Utility
0
 
LVL 11

Author Comment

by:bsharath
Comment Utility
0
 
LVL 59

Expert Comment

by:Chris Bottomley
Comment Utility
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

Find Ransomware Secrets With All-Source Analysis

Ransomware has become a major concern for organizations; its prevalence has grown due to past successes achieved by threat actors. While each ransomware variant is different, we’ve seen some common tactics and trends used among the authors of the malware.

Join & Write a Comment

Create high volume marketing opportunities using email signatures with these top 10 DOs and DON'Ts of email signature marketing.
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…
Learn the basics of modules and packages in Python. Every Python file is a module, ending in the suffix: .py: Modules are a collection of functions and variables.: Packages are a collection of modules.: Module functions and variables are accessed us…
This Experts Exchange video Micro Tutorial shows how to tell Microsoft Office that a word is NOT spelled correctly. Microsoft Office has a built-in, main dictionary that is shared by Office apps, including Excel, Outlook, PowerPoint, and Word. When …

744 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

17 Experts available now in Live!

Get 1:1 Help Now