使用 Excel-VBA 和 ADODB 连接在 OneDrive 上打开 Access 数据库答案

【问题标题】：Open an Access database on OneDrive using Excel-VBA and ADODB conecction使用 Excel-VBA 和 ADODB 连接在 OneDrive 上打开 Access 数据库
【发布时间】：2020-06-10 02:47:31
【问题描述】：

我需要使用 Excel-VBA 和 ADODB 连接或 SQL 在 OneDrive 上打开一个 Access DB。直到一个月前，ThisWorkBook.Path 对象给了我 OneDrive 上文件存储的本地路径，但现在我得到了一个带有这个对象的 http。

【问题讨论】：

这可能意味着您还没有从本地商店打开文件。请在您的问题中包括您如何打开工作簿（以及从哪个路径打开它）。还包括您从ThisWorkbook.Path 获得的http url。也许minimal reproducible example 可以帮助您改善问题。

标签： excel vba ms-access onedrive adodb

【解决方案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

【讨论】：