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:

Some videos you may like

Excel Facts

Best way to learn Power Query?
Read M is for (Data) Monkey book by Ken Puls and Miguel Escobar. It is the complete guide to Power Query.

RoryA

MrExcel MVP, Moderator
Joined
May 2, 2008
Messages
34,796
Office Version
365, 2019, 2016, 2010
Platform
Windows, MacOS
Welcome to the forum.

What's the error?
 

Pratapherono1

New Member
Joined
Sep 10, 2018
Messages
8
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)
 

Watch MrExcel Video

Forum statistics

Threads
1,095,404
Messages
5,444,265
Members
405,278
Latest member
Rashford

This Week's Hot Topics

Top