Solved

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

Posted on 2008-11-02
30
413 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
Master Your Team's Linux and Cloud Stack!

The average business loses $13.5M per year to ineffective training (per 1,000 employees). Keep ahead of the competition and combine in-person quality with online cost and flexibility by training with Linux Academy.

 
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
 
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

Master Your Team's Linux and Cloud Stack

Come see why top tech companies like Mailchimp and Media Temple use Linux Academy to build their employee training programs.

Question has a verified solution.

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

Follow this checklist to learn more about the 15 things you should never include in an email signature from personal quotes, animated gifs and out-of-date marketing content.
Following basic email etiquette rules will help you write a professional email and achieve a good, lasting impression with your contacts.
The viewer will learn how to count occurrences of each item in an array.
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…

831 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