Reply to Email and Loop a Number For Each Reply?

I have the following code in Outlook. Is there a way to set testNum to whatever testNum was in the last email + 1? For example. If someone sent me an email and I replied, it should say "Please refer to this RFQ as Quote #1" for this person. If i receive another email, I want the email to say "Please refer to this RFQ as Quote #2".

Is there a way to globally set testNum and have it changed after every time i send a email?


Sub ReplyMSG()
Dim testNum As Double
Dim olItem As Outlook.MailItem
Dim olReply As MailItem ' Reply
testNum = 0
For Each olItem In Application.ActiveExplorer.Selection
Set olReply = olItem.ReplyAll
With olReply
.Body = "Please refer to this RFQ as Quote #" & testNum + 1
End With
olReply.Display
Next olItem
End Sub

Maybe as follows

Code:

---

Sub ReplyMSG()

Dim testNum As Double
Dim olItem As Outlook.MailItem
Dim olInsp As Outlook.Inspector
Dim wdDoc As Object
Dim oRng As Object
Dim olReply As MailItem    ' Reply
    testNum = InputBox("Enter start number", "Quote Number", 1)
    For Each olItem In Application.ActiveExplorer.Selection
        Set olReply = olItem.ReplyAll
        With olReply
            Set olInsp = .GetInspector
            Set wdDoc = olInsp.WordEditor
            Set oRng = wdDoc.Range(0, 0)
            oRng.Text = "Please refer to this RFQ as Quote #" & testNum
        End With
        olReply.Display
        'olReply.Send
        testNum = testNum + 1
        DoEvents
    Next olItem
    Set olReply = Nothing
    Set olItem = Nothing
    Set olInsp = Nothing
    Set wdDoc = Nothing
    Set oRng = Nothing
End Sub

---

or if it was only for your use, you could store the number in the registry and lose the prompt e.g. as follows
The registry entry is at HKEY_CURRENT_USER\Software\VB and VBA Program Settings\ReplyMsg\

Code:

---

Sub ReplyMSG()

Dim testNum As Double
Dim olItem As Outlook.MailItem
Dim olInsp As Outlook.Inspector
Dim wdDoc As Object
Dim oRng As Object
Dim olReply As MailItem    ' Reply
    testNum = GetSetting("ReplyMsg", "Settings", "Quote Number", 1) '1 is the start number
    For Each olItem In Application.ActiveExplorer.Selection
        Set olReply = olItem.ReplyAll
        With olReply
            Set olInsp = .GetInspector
            Set wdDoc = olInsp.WordEditor
            Set oRng = wdDoc.Range(0, 0)
            oRng.Text = "Please refer to this RFQ as Quote #" & testNum
        End With
        olReply.Display
        'olReply.Send
        testNum = testNum + 1
        SaveSetting "ReplyMsg", "Settings", "Quote Number", testNum
        DoEvents
    Next olItem
    Set olReply = Nothing
    Set olItem = Nothing
    Set olInsp = Nothing
    Set wdDoc = Nothing
    Set oRng = Nothing
End Sub

Sub ResetStartNum()
    SaveSetting "ReplyMsg", "Settings", "Quote Number", 1 '1 is the start number
End Sub

---

gmayor Thank you very much! This works perfect!