如何通过VBA连接SharePoint上的MS Access数据库（无需OneDrive）？

方法1：通过SharePoint REST API/Graph API读写数据 #

由于OLEDB驱动无法直接连接存储在SharePoint上的Access数据库文件，你可以通过SharePoint提供的REST API或Microsoft Graph API实现数据读写，无需依赖OneDrive同步。

示例VBA代码（读取数据） #

Sub ReadDataFromSharePoint()
    Dim xmlHttp As Object
    Dim jsonResponse As String
    Dim url As String
    
    ' 替换为你的SharePoint站点和目标列表地址
    url = "https://your-sharepoint-site/_api/web/lists/getbytitle('YourListName')/items"
    
    Set xmlHttp = CreateObject("MSXML2.XMLHTTP.6.0")
    xmlHttp.Open "GET", url, False
    xmlHttp.setRequestHeader "Accept", "application/json;odata=verbose"
    ' 按需添加身份验证头部，比如Bearer令牌或NTLM验证
    ' xmlHttp.setRequestHeader "Authorization", "Bearer " & yourAccessToken
    
    xmlHttp.send
    
    If xmlHttp.Status = 200 Then
        jsonResponse = xmlHttp.responseText
        ' 需引入VBA JSON解析库（如VBA-JSON）处理返回数据
        Debug.Print jsonResponse
    Else
        Debug.Print "请求失败：" & xmlHttp.Status & " - " & xmlHttp.statusText
    End If
    
    Set xmlHttp = Nothing
End Sub

方法2：将Access数据库迁移为SharePoint列表 #

如果数据库结构允许，可将Access内的表迁移为SharePoint列表，之后用ADO直接连接列表操作：

示例连接字符串（连接SharePoint列表） #

Public Function fGetSharePointConn() As ADODB.Connection
    Dim conn As New ADODB.Connection
    Dim connStr As String
    
    connStr = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
              "WSS;IMEX=0;RetrieveIds=Yes;" & _
              "DATABASE=https://your-sharepoint-site/;" & _
              "LIST={List-GUID};"
    
    On Error GoTo ErrorHandler
    conn.Open connStr
    Set fGetSharePointConn = conn
    Exit Function
    
ErrorHandler:
    Debug.Print "连接错误：" & Err.Description
    Set fGetSharePointConn = Nothing
End Function

替换your-sharepoint-site为实际站点地址，{List-GUID}可在SharePoint列表设置中获取。

方法3：临时下载Access文件到本地操作后回传 #

通过VBA自动下载SharePoint上的Access文件到本地临时目录，用原有OLEDB逻辑处理数据，完成后上传回SharePoint覆盖原文件：

示例VBA代码（下载+操作+上传） #

Sub AccessFileOperation()
    Dim tempPath As String
    Dim sharePointUrl As String
    Dim xmlHttp As Object
    
    ' SharePoint上Access文件的完整地址
    sharePointUrl = "https://your-sharepoint-site/Shared%20Documents/UAT%20MyApp%20DB.accdb"
    ' 本地临时存储路径
    tempPath = Environ("TEMP") & "\UAT MyApp DB.accdb"
    
    ' 1. 下载文件
    Set xmlHttp = CreateObject("MSXML2.XMLHTTP.6.0")
    xmlHttp.Open "GET", sharePointUrl, False
    ' 根据SharePoint部署类型调整身份验证方式（如NTLM/Bearer）
    xmlHttp.setRequestHeader "Authorization", "NTLM"
    xmlHttp.send
    
    If xmlHttp.Status = 200 Then
        Open tempPath For Binary As #1
        Put #1, , xmlHttp.responseBody
        Close #1
    Else
        Debug.Print "下载失败：" & xmlHttp.Status & " - " & xmlHttp.statusText
        Exit Sub
    End If
    
    ' 2. 使用原有逻辑操作本地临时文件
    Dim cnx As ADODB.Connection
    Set cnx = fGetLocalConn(tempPath)
    ' 在此添加你的数据编辑代码
    ' ...
    
    ' 3. 上传文件回SharePoint
    Set xmlHttp = CreateObject("MSXML2.XMLHTTP.6.0")
    xmlHttp.Open "PUT", sharePointUrl, False
    xmlHttp.setRequestHeader "Authorization", "NTLM"
    xmlHttp.setRequestHeader "Content-Type", "application/x-msaccess"
    
    Open tempPath For Binary As #1
    xmlHttp.send ReadBinaryFile(1)
    Close #1
    
    If xmlHttp.Status = 200 Then
        Debug.Print "文件上传成功"
    Else
        Debug.Print "上传失败：" & xmlHttp.Status & " - " & xmlHttp.statusText
    End If
    
    ' 清理临时文件
    Kill tempPath
    Set xmlHttp = Nothing
    Set cnx = Nothing
End Sub

' 辅助函数：读取二进制文件内容
Function ReadBinaryFile(fileNum As Integer) As Byte()
    Dim fileSize As Long
    fileSize = LOF(fileNum)
    ReDim buffer(fileSize - 1) As Byte
    Get fileNum, , buffer
    ReadBinaryFile = buffer
End Function

' 修改后的本地数据库连接函数
Public Function fGetLocalConn(localPath As String) As ADODB.Connection
    Dim Cnx As ADODB.Connection
    On Error GoTo ErrorHandler
    If Cnx Is Nothing Or Cnx.Status = 0 Then
        Set Cnx = New ADODB.Connection
        With Cnx
            .Provider = "Microsoft.ACE.OLEDB.12.0"
            .ConnectionString = "Data Source=" & localPath & ";Persist Security Info=False;Jet OLEDB:Database Password=testpassword;"
            .Open
        End With
    End If
    Set fGetLocalConn = Cnx
    Exit Function
    
ErrorHandler:
    Debug.Print "连接错误：" & Err.Description
    Set fGetLocalConn = Nothing
End Function

注意：此方法需处理并发冲突问题，避免多用户同时操作导致数据覆盖；身份验证逻辑需匹配你的SharePoint环境。

内容的提问来源于stack exchange，提问作者Luca Tramontana