如何通过VBA将处理后的Excel工作表上传至Azure ADLS？

一、核心问题解答 #

1. 是否需要SAS Token？
   需要。ADLS（尤其是Gen2版本）需要身份验证，SAS Token是VBA场景下最简便的授权方式，你需要生成具备写入/创建权限的SAS Token，有效期要覆盖脚本的执行时段。

2. 如何指定ADLS路径？
   目标路径格式为：https://<你的ADLS账户名>.dfs.core.windows.net/<容器名>/<目录路径>/<目标文件名>.csv，最后拼接上SAS Token（格式为?<SAS Token内容>）。

二、完整VBA代码实现 #

1. 修复原列删除逻辑（重要！） #

原代码从前往后删除列会导致列号偏移，最终删错列，必须改为从后往前删除：

Sub ProcessAndUploadToADLS()
    ' 1. 执行数据标准化（删除指定列）
    DeleteTargetColumns
    
    ' 2. 定义ADLS相关参数，替换为你的实际信息
    Dim adlsUrlWithSAS As String
    adlsUrlWithSAS = "https://your-adls-account.dfs.core.windows.net/your-container/your-folder/target-file.csv?sv=2022-11-02&ss=bfqt&srt=sco&sp=rwdlacupiytfx&se=2024-12-31T23:59:59Z&st=2024-01-01T00:00:00Z&spr=https&sig=xxxxxx"
    
    ' 3. 临时保存处理后的工作表为CSV到系统临时目录
    Dim tempCsvPath As String
    tempCsvPath = Environ("TEMP") & "\temp_processed_data.csv"
    ThisWorkbook.Worksheets("File").SaveAs Filename:=tempCsvPath, FileFormat:=xlCSVUTF8
    
    ' 4. 上传CSV文件到ADLS
    UploadFileToADLS tempCsvPath, adlsUrlWithSAS
    
    ' 5. 清理本地临时文件
    Kill tempCsvPath
    
    MsgBox "数据处理并上传完成！", vbInformation
End Sub

' 修复后的列删除过程
Sub DeleteTargetColumns()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("File")
    
    ' 从后往前删除第2-5列，避免列号偏移导致删错列
    Dim k As Integer
    For k = 4 To 1 Step -1
        ws.Columns(k + 1).Delete
    Next k
End Sub

' 上传文件到ADLS的核心函数
Sub UploadFileToADLS(filePath As String, adlsUrlWithSAS As String)
    Dim xmlHttp As Object
    Set xmlHttp = CreateObject("WinHttp.WinHttpRequest.5.1")
    
    ' 读取本地CSV文件的二进制内容
    Dim fileContent As Byte
    Open filePath For Binary As #1
    ReDim fileContent(LOF(1) - 1)
    Get #1, , fileContent
    Close #1
    
    ' 发送PUT请求到ADLS REST API
    xmlHttp.Open "PUT", adlsUrlWithSAS, False
    xmlHttp.SetRequestHeader "Content-Type", "text/csv; charset=utf-8"
    xmlHttp.Send fileContent
    
    ' 检查上传结果
    If xmlHttp.Status < 200 Or xmlHttp.Status >= 300 Then
        MsgBox "上传失败，错误码：" & xmlHttp.Status & vbCrLf & xmlHttp.StatusText, vbCritical
        Err.Raise vbObjectError + 1001, , "ADLS上传失败"
    End If
End Sub

三、关键操作说明 #

1. 生成SAS Token #

在Azure门户中操作：

• 找到你的ADLS账户，进入目标容器
• 点击「生成SAS」按钮，权限勾选Create、Write（至少需要这两个）
• 设置合理的开始/结束时间，生成后复制完整的SAS Token，拼接到ADLS路径末尾（注意前面加?）

2. 参数替换 #

代码中需替换的部分：

• adlsUrlWithSAS：替换为你的ADLS完整路径+SAS Token
• 临时文件路径可根据需求调整，默认使用系统临时目录

3. 注意事项 #

• 你的Excel文件需保存为.xlsm格式（启用宏的工作簿）
• 确保网络环境允许访问ADLS的端点
• 代码中使用xlCSVUTF8保存CSV，需确保Data Factory读取时对应编码设置正确

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