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

Pratapherono1

New Member
Joined
Sep 10, 2018
Messages
8
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:
_______________________________________________________________________________________
Rich (BB code):
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!
 
Last edited by a moderator:

Excel Facts

Ambidextrous Undo
Undo last command with Ctrl+Z or Alt+Backspace. If you use the Undo icon in the QAT, open the drop-down arrow to undo up to 100 steps.
Welcome to the forum.

What's the error?
 
Upvote 0
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)
 
Upvote 0

Forum statistics

Threads
1,213,538
Messages
6,114,220
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top