How to create the No Reply Payroll Mailbox and Send All Draft Macro – Menzies

Below is the guide to setup the No-Reply-Mailbox and how to get the Macro working to send all draft emails. This basically sends all draft emails when they are populated from sage all in one click.

1. Open Outlook from Citrix - Citrix Workspace (cloud.com)

2. Type: No-Reply-Payroll@menzies.co.uk

3. Current Password: The payroll team should know this

(IT Support can find it in IT Glue)

4. Uncheck "Set up Outlook on my phone, too" and click Done

5. When Outlook opens press - ALT+F11

(Please use your laptop keyboard when pressing ALT+F11)

6. Right Click Project 1 - Insert - Module

7. Copy the following text into the text box.

(Copy all the text from the box below)

Public Declare Sub Sleep Lib "kernel32" (ByVal Milliseconds As Long)




Sub SendAllDraftEmails()

Dim objDrafts As Outlook.Items
Dim objDraft As Object
Dim strPrompt As String
Dim nResponse As Integer
Dim i As Long
Dim merror As Integer, Gcount As Integer

On Error GoTo err_handle

Set objDrafts = Outlook.Application.Session.GetDefaultFolder(olFolderDrafts).Items
Gcount = objDrafts.Count

If objDrafts.Count > 0 Then
strPrompt = "Are you sure you want to send out all the drafts?"
nResponse = MsgBox(strPrompt, vbQuestion + vbYesNo, "Confirm Sending")
'Disable iManage
Call DisableiManageAddIns

If nResponse = vbYes Then
For i = objDrafts.Count To 1 Step -1

objDrafts.Item(i).Send

' **** USE ONLY ON LARGE BATCHES OF (say) 500+ emails if you need to slow the program speed down ****
' **** this next line will PAUSE the program for 2 seconds before sending the NEXT Draft email **

' **** TO USE THE PROGRAM LINE REMOVE THE SINGLE QUOTE ' IN FRONT OF 'SLEEP 2000 ****
' Sleep 2000
Next
Else

strPrompt = "You opted NOT to send any Draft emails"
nResponse = MsgBox(strPrompt, vbInformation + vbOKOnly, "Confirm Sending")
GoTo Exit_For

End If

If merror > 0 And merror = Gcount Then
MsgBox "No Draft Emails Sent!", vbCritical, "Email Sending Errors!"
ElseIf merror > 0 And merror < Gcount Then
MsgBox "Some Draft Emails were sent - " & Trim(Str(merror)) & " emails were not sent", vbCritical, "Email Sending Errors!"
Else
MsgBox "All Draft Emails Sent!", vbInformation, "Email Sending"
End If
Else
MsgBox "No Draft Emails Found!", vbExclamation, "No Draft Emails Found"
End If

Exit Sub

err_handle:

If Err = "-2147467259" Then
MsgBox "There must be at least one email address or contact group in the TO, CC or BCC fields" & vbCrLf & "Fix it and re-run your emails", vbExclamation, "Error in Email Address!"
merror = 1 + merror
Resume Next
End If

Exit_For:

End Sub

Sub DisableiManageAddIns()
Dim objComAddIn As COMAddIn, sRegKey As String, sAddinDesc
sAddinDesc = "iManage Work Addin for Outlook"
On Error Resume Next
With CreateObject("WScript.Shell")
For Each objComAddIn In Application.COMAddIns
If objComAddIn.Description = sAddinDesc Then
If objComAddIn.Connect Then
sRegKey = "HKEY_CURRENT_USER\Software\Microsoft\Office\Outlook\AddIns\" & objComAddIn.ProgId & "\LoadBehavior"
Err.Clear
objComAddIn.Connect = False
If Err Then
.RegWrite sRegKey, 2, "REG_DWORD"
End If
End If
End If
Next
End With
End Sub

Sub EnableiManageAddIns()
Dim objComAddIn As COMAddIn, sRegKey As String, sAddinDesc
sAddinDesc = "iManage Work Addin for Outlook"
On Error Resume Next
With CreateObject("WScript.Shell")
For Each objComAddIn In Application.COMAddIns
If objComAddIn.Description = sAddinDesc Then
If objComAddIn.Connect Then
sRegKey = "HKEY_CURRENT_USER\Software\Microsoft\Office\Outlook\AddIns\" & objComAddIn.ProgId & "\LoadBehavior"
'Err.Clear
'objComAddIn.Connect = True
'If Err Then
.RegWrite sRegKey, 3, "REG_DWORD"
'End If
End If
End If
Next
End With
End Sub