Schedule and Send a Message to People Who Have Sent You a Message

I put this solution together for a reader who goes by the name birdmanjrmd. Birdmanjrmd asked for a script that will

• Create a new email
• Process all the messages in a given Outlook folder. For each message
  • Add the sender’s address to the new email’s list of recipients.
  • Move the message out of the source folder to a target folder.
• Set the new message’s subject and body.
• Send the message.

Birdmanjrmd wants the script to run once each day, so I wrote it in VBscript. This will allow him to run it from a scheduled task using Windows Task Scheduler.

Instructions.

1. Open Notepad.
2. Copy the code below and paste it into Notepad.
3. Edit the code as needed. I included a comment where changes are needed.
4. Save the file. You can name it anything you want so long as the file extension is .vbs.
5. Test the script by double-clicking it.
6. Open Windows Task Scheduler.
7. Create a new task.
8. Set the task to run at whatever interval you choose.
9. Set the task’s action to run a script and select this script as the one to run.

'On the next line edit the message subject
    Const MSG_SUBJECT = "Test"
    'On the next line edit the message body.  You can use HTML formatting.
    Const MSG_BODY = "TEST 12"
    'On the next line edit the path to the source folder in Outlook
    Const SRC_FOLDER = "davist@qutech.com\Inbox\test"
    'On the next line edit the path to the target folder in Outlook
    Const TGT_FOLDER = "davist@qutech.com\Inbox\test\testc"
    Const olMailItem = 0
    Const olBCC = 3
'--> Declare some variables
    Dim olkApp, olkSes, olkFld, olkFin, olkItm, olkMsg, olkRcp, intPtr
'--> Connect to Outlook
    Set olkApp = CreateObject("Outlook.Application")
    Set olkSes = olkApp.GetNamespace("MAPI")
    olkSes.Logon olkApp.DefaultProfileName
'--> Open the folders
    Set olkFld = OpenOutlookFolder(SRC_FOLDER)
    Set olkFin = OpenOutlookFolder(TGT_FOLDER)
'--> Create a new email
    Set olkMsg = olkApp.CreateItem(olMailItem)
'--> Process the items in the soure folder
    For intPtr = olkFld.Items.Count To 1 Step -1
        Set olkItm = olkFld.Items.Item(intPtr)
        Set olkRcp = olkMsg.Recipients.Add(olkItm.SenderEmailAddress)
        olkRcp.Type = olBCC
        olkItm.Move olkFin
    Next
'--> Finalize and send the email
    With olkMsg
        .Recipients.ResolveAll
        .Subject = MSG_SUBJECT
        .HTMLBody = MSG_BODY
        .Display
    End With
'--> Disconnect from Outlook
    olkSes.Logoff
'--> Destroy all objects
    Set olkMsg = Nothing
    Set olkItm = Nothing
    Set olkFin = Nothing
    Set olkFld = Nothing
    Set olkSes = Nothing
    Set olkApp = Nothing
'--> Terminate the script
    Wscript.Quit

Function OpenOutlookFolder(strFolderPath)
    Dim arrFolders, varFolder, bolBeyondRoot
    On Error Resume Next
    If strFolderPath = "" Then
        Set OpenOutlookFolder = Nothing
    Else
        Do While Left(strFolderPath, 1) = "\"
            strFolderPath = Right(strFolderPath, Len(strFolderPath) - 1)
        Loop
        arrFolders = Split(strFolderPath, "\")
        For Each varFolder In arrFolders
            Select Case bolBeyondRoot
                Case False
                    Set OpenOutlookFolder = olkApp.Session.Folders(varFolder)
                    bolBeyondRoot = True
                Case True
                    Set OpenOutlookFolder = OpenOutlookFolder.Folders(varFolder)
            End Select
            If Err.Number  0 Then
                Set OpenOutlookFolder = Nothing
                Exit For
            End If
        Next
    End If
    On Error GoTo 0
End Function