如何在保存到 OneDrive 的 Excel 工作簿中運行 SQL 查詢？

Question

我想對包含在單個 Excel 工作簿中的表運行 SQL 查詢。 我的 VBA 代碼使用 ADODB 運行這些 SQL 查詢。

將工作簿保存在 OneDrive 中時打開連接失敗，但將工作簿保存到本地驅動器時可以正常工作。

如何在單個 excel 工作簿中的表上運行 SQL，同時保存在 OneDrive 上？

當書籍保存在本地但不在 OneDrive 上時，該代碼有效。 唯一的變化是在每種情況下看起來完全不同的文件路徑：

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

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

我已經在連接字符串中的文件路徑周圍嘗試了一些東西，但不出所料，它們沒有工作：

1. 原來的

   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. 將“/”替換為“\”

    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. 在路徑周圍添加方括號

   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. 在路徑周圍添加引號

   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";

我意識到我可以通過在運行此代碼時將其保存在本地來避免這種情況，然后再將其保存回 OneDrive，但如果可能的話，我想避免這種情況。

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.

這是我的代碼：

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

在cn.Open strCon行，出現如下錯誤：

運行時錯誤'-2147467259（80004005）'；
object '_Connection' 的方法 'Open' 失敗

謝謝！

Answer 1

這是我獲取文件路徑的解決方案。

'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

Answer 2

您可以使用以下函數將OneDrivePath轉換為LocalPath 。

對於這個問題，網上有很多解決方案，但幾乎沒有一個適用於所有不同類型的 OneDrive 帳戶和文件夾......（個人、商業、 SharePoint業務、來自其他人的 OneDrives 的同步文件夾等）

這就是為什么我編寫了這個函數來處理我迄今為止遇到的各種 OneDrive 掛載。

Private Function GetLocalPath(path As String) As String
    Const HKEY_CURRENT_USER = &H80000001
    Dim objReg As Object
    Dim regPath As String
    Dim subKeys() As Variant
    Dim subKey As Variant
    Dim strValue As String
    Dim strMountpoint As String
    Dim strSecPart As String
    
    Static pathSep As String
    If pathSep = "" Then pathSep = Application.PathSeparator
    
    Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
    regPath = "Software\SyncEngines\Providers\OneDrive\"
    objReg.EnumKey HKEY_CURRENT_USER, regPath, subKeys

    For Each subKey In subKeys
        objReg.GetStringValue HKEY_CURRENT_USER, regPath & subKey, _
                            "UrlNamespace", strValue
        If InStr(path, strValue) > 0 Then
            objReg.GetStringValue HKEY_CURRENT_USER, regPath & subKey, _
                                "MountPoint", strMountpoint
            strSecPart = Replace(Mid(path, Len(strValue)), "/", pathSep)
            GetLocalPath = strMountpoint & strSecPart
            
            Do Until Dir(GetLocalPath, vbDirectory) <> "" Or _
                     InStr(2, strSecPart, pathSep) = 0
                strSecPart = Mid(strSecPart, InStr(2, strSecPart, pathSep))
                GetLocalPath = strMountpoint & strSecPart
            Loop
            Exit Function
        End If
    Next
    GetLocalPath = path
End Function

請注意，理論上您可以只使用"\"而不是Application.PathSeparator ，因為此問題僅發生在 Windows 上，因此此功能僅在 Windows 系統上是必需的。

Answer 3

將 html: 替換為“”。 這會讓你更進一步。