Unable to execute VBA (interacts with Outlook) in Windows 10

[Pratapherono1]

Hi,

I have recently upgraded my system version from Windows 7 to Windows 10.
My Microsoft Excel version also got upgraded from 2007 to 2016.

However, I am unable to run the below VBA (in Windows 10) and is stuck in the step - highlighted in red:
_______________________________________________________________________________________

Public Sub doSave()
Dim I As Long
Dim em As Object 'Outlook.MailItem
Dim out As Object 'New Outlook.Application
Dim olFolder As Object 'Outlook.Folder
Dim Item As Object
Dim outNS As Object 'Outlook.Namespace
Dim n As Long, path As String
Dim fs As New Scripting.FileSystemObject, J As Long, pathSP As String, TradeDate As Date, sourceName As String, fl As Scripting.File, doOverwrite As Boolean
    Set out = getOutlook()
    If Not fs.FolderExists("//securedteamsites.zone1.scb.net@SSL/DavWWWRoot/sites/GSSCSAFundServices/Shared Documents/") Then
        MsgBox "Please log into SharePoint by:" & vbCr & _
        "1. Open SharePoint in browser" & vbCr & _
        "2. Navigate to Documents" & vbCr & _
        "3. Library|Open with Explorer" & vbCr & _
        "4. Provide credentials for the SharePoint as provided by the administrator"
    Else
    'If vbYes = MsgBox("Please confirm you are logged into SharePoint", vbYesNo) Then
        TradeDate = getSet("Trade Date")
        doOverwrite = getSet("Overwrite")
        Set outNS = out.GetNamespace("MAPI")
        'Set olFolder = outNS.GetDefaultFolder(olFolderSentMail)
        If getSet("Live") Then
            Set olFolder = outNS.Folders("Mailbox - Securities-Services, ZATrustee").Folders("Inbox")
        Else
            Stop 'test if out.olFolderSentMail exists
            Set olFolder = outNS.GetDefaultFolder(olFolderSentMail)
        End If
        With shDash.Range("G3")
            For I = 1 To 1000
                setStatusBar I & " - Saving"
                If .Cells(I, 3).value = "" Then Exit For
                If .Cells(I, 1).value = 1 Then
                    Set em = outNS.GetItemFromID(.Cells(I, 3).value)
                    path = .Cells(I, 9).value
                    
                    'path = folderMailMerge(path, em)
                    If Not fs.FolderExists(path) Then
                        createFolder fs, path
                    End If
                    
                    'path = path & .Cells(I, 2) & "-" & .Cells(I, 6) & "-" & Format(.Cells(I, 5), "yyyy.mm.dd HH-MM-SS") & "-" & J & ".msg"
                    'path = path & .Cells(I, 2) & "-" & Format(.Cells(I, 5), "yyyy.mm.dd HH-MM-SS") & ".msg"
                    sourceName = .Cells(I, 2).value
                    setStatusBar I & " - Saving: " & sourceName
                    path = path & .Cells(I, 2) & "-" & Format(TradeDate, "yyyy.mm.dd") & ".msg"
                    path = Replace(path, "[", "(")
                    path = Replace(path, "]", ")")
                    path = Replace(path, ":", "-")
                    path = Replace(path, "&", "-")
                    DoEvents
                    If fs.fileExists(path) Then
                        If doOverwrite Then
                            fs.DeleteFile path
                            em.SaveAs path
                        End If
                    Else
                        em.SaveAs path
                    End If
                        
                    If fs.fileExists(path) Then
                        pathSP = .Cells(I, 10).value
                        If saveToSharePoint(pathSP, path, doOverwrite) Then
                            em.UnRead = False
                            .Cells(I, 1).value = "Saved"
                        Else
                            .Cells(I, 1).value = "Saved on Network, not on SharePoint"
                        End If
                    Else
                        MsgBox "Failed to save the file to: " & vbCr & path & vbCr & "Please try again later, or contact support", vbCritical
                    End If
                End If
            Next I
        End With
        logMe False
        setStatusBar ""
        MsgBox "Done: emails saved into the network destination"
    End If
End Sub

Please help - your assistance will be of great help.

Thank you!

 

[RoryA]

Welcome to the forum.

What's the error?

 

[Pratapherono1]

Hi Rory,

Below is the error message:

Run-time error '-2147221233 (8004010f)':
The attempted operation failed. An object could not be found.


Please note that the VBA is still working in Windows 7 (Excel 2007) - However, I get an error with Windows 10 (Excel 2016)