3

I would like to run SQL queries on tables all contained within a single Excel workbook. My VBA code uses ADODB to run these SQL queries.

Opening connection fails when the workbook is saved in OneDrive, but works when workbook is saved to a local drive.

How can I run SQL on tables within a single excel workbook, while saved on OneDrive?

The code works when the book is saved locally but not on OneDrive. The only change is the file path which looks fairly different in each case:

OneDrivePathExample = "https://d.docs.live.net/....xlsb"

LocalPathExample = "C:\My Documents\....xlsb"

I've experimented with a few things around the file path in the connection string but, unsurprisingly, they didn't work:

  1. Original

    Provider=Microsoft.ACE.OLEDB.12.0;Data Source=https://d.docs.live.net/.../Documents/Financial Tracker.xlsb;Extended Properties="Excel 12.0;HDR=Yes;IMEX=1";
    
  2. Replacing "/" with "\"

    Provider=Microsoft.ACE.OLEDB.12.0;Data Source=https:\\d.docs.live.net\...\Documents\Financial Tracker.xlsb;Extended Properties="Excel 12.0;HDR=Yes;IMEX=1";`
    
  3. Adding square brackets around path

    Provider=Microsoft.ACE.OLEDB.12.0;Data Source=[https://d.docs.live.net/.../Documents/Financial Tracker.xlsb];Extended Properties="Excel 12.0;HDR=Yes;IMEX=1";
    
  4. Adding quotes around path

    Provider=Microsoft.ACE.OLEDB.12.0;Data Source="https://d.docs.live.net/.../Documents/Financial Tracker.xlsb";Extended Properties="Excel 12.0;HDR=Yes;IMEX=1";
    

I realize that I can avoid this by saving it locally when running this code, and then save it back to OneDrive afterwards but I would like to avoid this if possible.

I also realize that I can write VBA code that does what I'm trying to do with SQL, however I did that originally but switched to the SQL method because SQL was way faster.

Here's my code:

Function OpenRST(strSQL As String) As ADODB.Recordset
''Returns an open recordset object

Dim cn As ADODB.Connection
Dim strProvider As String, strExtendedProperties As String
Dim strFile As String, strCon As String

strFile = ThisWorkbook.FullName

strProvider = "Microsoft.ACE.OLEDB.12.0"
strExtendedProperties = """Excel 12.0;HDR=Yes;IMEX=1"";"


strCon = "Provider=" & strProvider & _
     ";Data Source=" & strFile & _
     ";Extended Properties=" & strExtendedProperties

Set cn = CreateObject("ADODB.Connection")
Set OpenRST = CreateObject("ADODB.Recordset")

cn.Open strCon  ''This is where it fails

OpenRST.Open strSQL, cn

End Function

On the cn.Open strCon line, the following error appears:

Run-time error '-2147467259 (80004005)';
Method 'Open' of object '_Connection' failed

Thanks!

marc_s
  • 732,580
  • 175
  • 1,330
  • 1,459
DavidN
  • 630
  • 1
  • 4
  • 13
  • Is local workbook synched to OneDrive? – Parfait Jan 07 '19 at 21:37
  • @Parfait, I might be misunderstanding your question, but no it's just saved to OneDrive. I don't have a local copy normally. – DavidN Jan 07 '19 at 22:00
  • 4
    So you do not have a synched OneDrive on your desktop similar to Dropbox? Consider doing so as Jet/ACE SQL engine cannot point to URLs for connections. – Parfait Jan 07 '19 at 22:10
  • @Parfait, thanks that might be a suitable workaround for me assuming it will work from multiple computers. I'll give it a shot tonight. – DavidN Jan 07 '19 at 22:23
  • @Parfait 's hint does indeed work. Note that even if your file is then synchronized to your PC, `ThisWorkbook.FullName` will still return a OneDrive web path so your code example still won't work. A reliable way to convert the web path to the local path the file is synchronized to is available [here](https://stackoverflow.com/a/73577057/12287457). – GWD Sep 05 '22 at 11:57

2 Answers2

0

this is my solution to get file path.

'This Function search root folder as C: ,D: ...
'Search into all OneDrive folders
Option Explicit
Private Const strProtocol   As String = "Http"
Private Const pathSeparator As String = "\"

Function MainFindFile(ByRef NullFilePath As String, Optional FileName As String) As Boolean
    
    Dim fso                 As FileSystemObject 'Necessary enable microsoft scripting runtime in references
    Dim UserRootFolder      As Folder
    Dim SecondSubFolders    As Folder
    Dim ThirdSubFolders     As Folder
    Dim InitialPath         As String
    Dim OneDriveFolderName  As String
    
    Set fso = New Scripting.FileSystemObject
    
    InitialPath = ActiveWorkbook.FullName
    If FileName = vbNullString Then FileName = ActiveWorkbook.Name

    If InStr(1, InitialPath, strProtocol, vbTextCompare) > 0 Then
        InitialPath = Environ("SystemDrive")
        InitialPath = InitialPath & Environ("HomePath")
        
        'Gets all folders in user root folder
        Set UserRootFolder = fso.GetFolder(InitialPath)
        
        For Each SecondSubFolders In UserRootFolder.SubFolders
            'Searches all folders of OneDrive, you may have how many Onedrive's folders as you want
            If InStr(1, SecondSubFolders.Name, "OneDrive", vbTextCompare) > 0 Then
                OneDriveFolderName = InitialPath & pathSeparator & SecondSubFolders.Name
                'Verifies if file exists in root of Onedrive Folder
                MainFindFile = SearchFile(OneDriveFolderName, FileName, NullFilePath)
                If MainFindFile Then Exit For

                'Uses recursive function to percur all subfolders in root of OneDrive
                For Each ThirdSubFolders In fso.GetFolder(OneDriveFolderName).SubFolders
                    MainFindFile = RecursiveFindFile(ThirdSubFolders, FileName, NullFilePath)
                    If MainFindFile Then Exit For
                Next ThirdSubFolders
            End If
            If MainFindFile Then Exit For
        Next SecondSubFolders
        
    End If
    
    MsgBox NullFilePath
    
End Function
Private Function RecursiveFindFile(Folder As Folder, FileName As String, ByRef NullFilePath As String) As Boolean

    Dim fso         As FileSystemObject
    Dim objFolder   As Folder
    Dim Result      As Boolean
    
    Set fso = New Scripting.FileSystemObject
    
    'Verifies if file exists in root of Onedrive Folder
    RecursiveFindFile = SearchFile(Folder.Path, FileName, NullFilePath)
    If RecursiveFindFile Then Exit Function
    
    For Each objFolder In Folder.SubFolders
        If Not SearchFile(objFolder.Path, FileName, NullFilePath) Then
            RecursiveFindFile = RecursiveFindFile(objFolder, FileName, NullFilePath)
            If RecursiveFindFile Then Exit For
        Else
            RecursiveFindFile = True
            Exit For
        End If
    Next objFolder
    
End Function
Private Function SearchFile(Path As String, FileName As String, ByRef NullFilePath As String) As Boolean
    
    'NullFilePath is a byref variable to be filled by this function
    Dim fso As New Scripting.FileSystemObject
    
    If fso.FileExists(Path & pathSeparator & FileName) Then
        NullFilePath = Path & pathSeparator & FileName
        SearchFile = True
    End If
    
End Function
-2

Replace the htpps: with "". This will bring you one step further.

Michael
  • 1
  • 1