Outlook VBA - new Run-time Error occurring when using Move Folder code - Call was rejected by callee


Board Regular
Jul 19, 2016
Office Version
  1. 365
  1. Windows
Hi Folks,

I use an excel worksheet to direct the movement of folders in outlook. Outlook VBA calls the excel workbook and finds the move from, move to columns etc.

I have been working from home no issues, but then I've connected back onto the company network this morning at the office and gotten the following error (see attached image).
My other outlook VBA is functioning (to create folders, rename folders etc).

Here is the code (below). The line that's errored is
VBA Code:
ExcelApp.Visible = True
suggesting that outlook is failing to open excel?

VBA Code:
Option Explicit

Public Sub Move_Folders()

    Dim workbookFileName    As String
    Dim workbookOpened      As Boolean
    Dim ExcelApp            As Object
    Dim ExcelWb             As Object
    Dim ExcelSh             As Object
    Dim lastRow             As Long
    Dim r                   As Long
    Dim outSourceFolder     As Outlook.MAPIFolder
    Dim outDestFolder       As Outlook.MAPIFolder
    Const cExcelWorkbook As String = "S:\APS_Logistics\Logistics Support\Dougs jobs\Time-manager.xlsm"     'CHANGE THIS
    On Error Resume Next
    Set ExcelApp = GetObject(, "Excel.Application")
    If Err.Number <> 0 Then
        Set ExcelApp = CreateObject("Excel.Application")
    End If
    On Error GoTo 0
    workbookFileName = Dir(cExcelWorkbook)
    'MsgBox workbookFileName
    If workbookFileName <> vbNullString Then
        Set ExcelWb = Nothing
        workbookOpened = False
        On Error Resume Next
        Set ExcelWb = ExcelApp.Workbooks(workbookFileName)
        If ExcelWb Is Nothing Then
            Set ExcelWb = ExcelApp.Workbooks.Open(cExcelWorkbook, ReadOnly:=True, Password:="asdfjkl;")
            workbookOpened = True
        End If
        On Error GoTo 0
        MsgBox cExcelWorkbook & " not found"
        Exit Sub
    End If
    ExcelApp.Visible = True
    Set ExcelSh = ExcelWb.Worksheets("MoveFolders")
    With ExcelSh
        lastRow = ExcelSh.cells(.rows.Count, 1).End(xlUp).Row
        For r = 2 To lastRow
            Set outSourceFolder = Get_Folder(ExcelSh.cells(r, 1).Value)
            Set outDestFolder = Get_Folder(ExcelSh.cells(r, 2).Value)
            If Not outSourceFolder Is Nothing And Not outDestFolder Is Nothing Then
                outSourceFolder.MoveTo outDestFolder
                MsgBox "Row " & r & vbCrLf & _
                       outSourceFolder.folderPath & vbCrLf & _
                       "moved to " & vbCrLf & _
                MsgBox "Row " & r & vbCrLf & _
                       IIf(outSourceFolder Is Nothing, "Source folder '" & .cells(r, 1).Value & "' not found" & vbCrLf, "") & _
                       IIf(outDestFolder Is Nothing, "Destination folder '" & .cells(r, 1).Value & "' not found" & vbCrLf, "")

            End If
    End With
    If workbookOpened Then
        ExcelWb.Close SaveChanges:=False
        Set ExcelWb = Nothing
        Set ExcelApp = Nothing
    End If

End Sub

Private Function Get_Folder(folderPath As String, Optional ByVal outStartFolder As MAPIFolder) As MAPIFolder
    'Search for the specified folder path starting at the optional MAPI start folder.
    'If outStartFolder is specified then start in that folder and search for the specified folder path.
    'If outStartFolder is not specified then the search starts at the specified folder path.  The folder path
    'can start with a top-level folder by prepending the folder path with "\\".  Folder names are separated by "\".
    '   "\\Account Name\Folder1\Subfolder1\Sub-Subfolder1"  - folders in main (active) top-level folder
    '   "\\Archive Folders\Folder1\Subfolder1"              - folders in archive folder
    '   "Folder1\Subfolder1\Sub-Subfolder1"                 - folders in main (active) top-level folder
    'If the whole subfolder path is found this function returns the last subfolder as a MAPIFolder object, otherwise
    'it returns Nothing
    Dim NS As NameSpace
    Dim outFolder As MAPIFolder
    Dim outFolders As folders
    Dim folders As Variant
    Dim i As Long
    Set NS = Application.GetNamespace("MAPI")
    If outStartFolder Is Nothing Then
        If Left(folderPath, 2) = "\\" Then
            'folderPath starts with a top level folder ("\\Folder name\xxx\yyy"), so look for that
            'folder and if found set outStartFolder to it
            folders = Split(Mid(folderPath, 3), "\")
            Set outFolders = NS.folders
            Set outStartFolder = Nothing
            i = 1
            While i <= outFolders.Count And outStartFolder Is Nothing
                Set outFolder = outFolders(i)
                If outFolder.Name = folders(0) Then Set outStartFolder = outFolder
                i = i + 1
            i = 1   'match folder paths from 2nd folder in path
            'Top level folder not specified, so start subfolders search at parent folder of the Inbox
            Set outStartFolder = NS.GetDefaultFolder(olFolderInbox).Parent
            folders = Split(folderPath, "\")
            i = 0
        End If
        folders = Split(folderPath, "\")
        i = 0
    End If
    Set outFolder = outStartFolder
    While i <= UBound(folders) And Not outFolder Is Nothing
        If folders(i) <> "" Then
            Set outFolder = Nothing
            On Error Resume Next
            Set outFolder = outStartFolder.folders(folders(i))
            On Error GoTo 0
            Set outStartFolder = outFolder
        End If
        i = i + 1
    Set Get_Folder = outFolder
End Function

Does anyone know why this error message occurs and how to fix it?

Kind regards,



  • MoveFoldersOutlookVBA error.PNG
    MoveFoldersOutlookVBA error.PNG
    12.4 KB · Views: 2
  • Line that's erroring.PNG
    Line that's erroring.PNG
    26.8 KB · Views: 2

Some videos you may like

Excel Facts

How to calculate loan payments in Excel?
Use the PMT function: =PMT(5%/12,60,-25000) is for a $25,000 loan, 5% annual interest, 60 month loan.

Watch MrExcel Video

Forum statistics

Latest member