VBA读取OneDrive共享TXT文件返回HTML的解决及编辑方法

一、读取OneDrive TXT文件返回HTML的解决方案 #

OneDrive的共享链接即使带有download=1参数，也可能因重定向逻辑或请求头验证，返回网页HTML而非文件内容。以下是具体解决方法：

1. 使用官方API直接获取文件内容 #

OneDrive提供了公开共享文件的直接访问API，步骤如下：

• 提取原始共享链接（去掉末尾的?e=xxx参数）：

  https://1drv.ms/t/c/08961629ae94e369/Eck3SHXgoWZPsTLr7YOtolwB1hjrCHrtMGIjWRXN4z_R9A
  

• 将该链接转换为URL安全的Base64编码（替换+为-，/为_，去掉末尾的=）
• 构造API请求链接：

  https://api.onedrive.com/v1.0/shares/u!<Base64编码>/root/content
  

  此链接会直接返回TXT文件的原始内容，无需处理网页跳转。

2. 优化HTTP请求头与重定向处理 #

若不想使用API链接，可修改VBA代码，添加浏览器模拟请求头并手动处理重定向：

Dim UrlArchivo As String
Dim Respuesta As String
Dim Http As Object

UrlArchivo = "https://1drv.ms/t/c/08961629ae94e369/Eck3SHXgoWZPsTLr7YOtolwB1hjrCHrtMGIjWRXN4z_R9A?e=7KtMIp&download=1"

Set Http = CreateObject("MSXML2.ServerXMLHTTP.6.0")
Http.Open "GET", UrlArchivo, False
' 添加浏览器请求头，避免被OneDrive拦截
Http.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/114.0.0.0 Safari/537.36"
Http.Send

' 手动处理302重定向
If Http.Status = 302 Then
    Dim redirectUrl As String
    redirectUrl = Http.getResponseHeader("Location")
    Http.Open "GET", redirectUrl, False
    Http.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/114.0.0.0 Safari/537.36"
    Http.Send
End If

If Http.Status = 200 Then
    Respuesta = Http.responseText
    ' 后续内容处理逻辑
Else
    MsgBox "无法访问文件，错误码：" & Http.Status, vbCritical
End If

3. 替换HTTP对象 #

尝试使用WinHttp.WinHttpRequest.5.1替代MSXML2.ServerXMLHTTP，部分场景下兼容性更好：

Set Http = CreateObject("WinHttp.WinHttpRequest.5.1")

二、读取正常后编辑OneDrive文件的方法 #

编辑OneDrive文件需满足两个前提：

• 你拥有该文件的编辑权限（共享链接设为可编辑，或你是文件所有者）
• 通过OneDrive API进行更新，直接HTTP请求无法绕过权限验证

以下是VBA实现编辑的核心逻辑（需OAuth2身份验证）：

1. 获取访问令牌：通过Microsoft账户授权获取OneDrive API的访问令牌（需注册Azure应用，授权流程参考官方文档）
2. 用PUT请求更新文件内容：

Sub UpdateOneDriveFile()
    Dim accessToken As String
    Dim fileContent As String
    Dim apiUrl As String
    Dim Http As Object
    
    ' 替换为你的访问令牌和文件API地址
    accessToken = "你的OAuth2访问令牌"
    apiUrl = "https://api.onedrive.com/v1.0/shares/u!<Base64编码>/root/content"
    fileContent = "新的文件内容，例如修改后的CSV行数据"
    
    Set Http = CreateObject("MSXML2.ServerXMLHTTP.6.0")
    Http.Open "PUT", apiUrl, False
    Http.setRequestHeader "Authorization", "Bearer " & accessToken
    Http.setRequestHeader "Content-Type", "text/plain"
    Http.Send fileContent
    
    If Http.Status = 200 Then
        MsgBox "文件更新成功", vbInformation
    Else
        MsgBox "更新失败，错误码：" & Http.Status & "，信息：" & Http.responseText, vbCritical
    End If
End Sub

额外代码优化建议 #

你的原始代码存在几个逻辑问题，可能导致运行异常：

1. 循环外提前执行Datos = Split(linea, ",")，此时linea未赋值，会引发错误
2. 循环内用NombreBuscado = Datos(0)覆盖了从表单获取的查询值，导致匹配逻辑失效
3. 重复的Case "Pendiente."分支，第二个分支永远不会执行

修正后的核心循环逻辑示例：

' 保留表单查询值，避免循环内覆盖
Dim targetNombre As String, targetIdentificacion As String
targetNombre = Me.txtNombre
targetIdentificacion = Me.txtIdentificacion

' 读取并处理文件内容
ContenidoLimpio = Replace(Http.responseText, vbCrLf, vbLf)
Lineas = Split(ContenidoLimpio, vbLf)

CoincidenciaEncontrada = False

For Each linea In Lineas
    linea = Trim(linea)
    If Len(linea) > 0 Then
        Debug.Print "Procesando línea: " & linea
        Datos = Split(linea, ",")
        If UBound(Datos) >= 3 Then
            Dim fileNombre As String, fileIdentificacion As String, fileEstado As String
            fileNombre = Trim(Datos(0))
            fileIdentificacion = Trim(Datos(1))
            fileEstado = Trim(Datos(3))
            
            ' 匹配查询条件
            If fileIdentificacion = targetIdentificacion Then
                CoincidenciaEncontrada = True
                Select Case fileEstado
                    Case "Pendiente."
                        MsgBox "Se procederá a activar su Licencia de REGEJAM, está licencia será válida por una sola vez.", vbInformation
                    Case "Activada."
                        MsgBox "La licencia es válida y pertenece a: " & fileNombre & ", cédula: " & fileIdentificacion, vbInformation
                    Case "Suspendida"
                        MsgBox "La licencia está suspendida.", vbExclamation
                    Case Else
                        MsgBox "Estado desconocido para la licencia: " & fileEstado, vbCritical
                End Select
                Exit For ' 找到匹配后退出循环
            End If
        Else
            Debug.Print "Formato incorrecto en línea: " & linea
        End If
    Else
        Debug.Print "Línea ignorada porque está vacía."
    End If
Next linea

' 循环结束后检查匹配结果
If Not CoincidenciaEncontrada Then
    MsgBox "No se encontró coincidencia en el archivo.", vbCritical
End If

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