如何将扭矩数据采集VBA代码集成到企业OneDrive/Teams云实现每日保存？

问题根源 #

你的代码硬编码了本地路径C:\Austin Manufacturing Engineering\Documents\General\LVF Capper Torque\，但这不符合OneDrive for Business的实际同步规则：

• 企业版OneDrive本地同步路径通常以C:\Users\[你的用户名]\OneDrive - [企业名称]\开头
• 若目标是Teams频道文件，对应路径是OneDrive同步目录下的Teams\[频道名称]\子文件夹
• 硬编码路径大概率不存在，或当前用户无访问权限

修正后的代码 #

以下代码会自动获取OneDrive企业版路径，检查并创建目标目录，完成数据处理与云端保存：

Public Sub UploadDataToFile()
    Dim currentDate As Date
    Dim lastRow As Long
    Dim i As Long
    Dim fileName As String
    Dim baseOneDrivePath As String
    Dim targetFolderPath As String
    Dim filePath As String
    Dim newWorkbook As Workbook
    
    ' 获取今日日期
    currentDate = Date
    
    ' 清理历史数据（仅保留当日扭矩数据）
    With ThisWorkbook.ActiveSheet
        lastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
        For i = lastRow To 2 Step -1
            If .Cells(i, "B").Value < currentDate Then
                .Rows(i).Delete
            End If
        Next i
    End With
    
    ' 生成带日期的文件名
    fileName = Format(currentDate, "yyyy-mm-dd") & "TorqueValues.xlsx"
    
    ' 自动读取企业版OneDrive根路径
    On Error Resume Next
    baseOneDrivePath = Environ("OneDriveCommercial")
    On Error GoTo 0
    
    ' 自动获取失败时，手动替换为你的OneDrive同步根路径（示例）
    If baseOneDrivePath = "" Then
        baseOneDrivePath = "C:\Users\你的用户名\OneDrive - Austin Manufacturing Engineering\"
    End If
    
    ' 配置目标文件夹路径（对应OneDrive/Teams的存储目录）
    targetFolderPath = baseOneDrivePath & "Documents\General\LVF Capper Torque\"
    
    ' 检查文件夹是否存在，不存在则创建
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    If Not fso.FolderExists(targetFolderPath) Then
        fso.CreateFolder targetFolderPath
    End If
    
    ' 拼接完整文件路径
    filePath = targetFolderPath & fileName
    
    ' 复制数据到新工作簿
    Set newWorkbook = Workbooks.Add
    ThisWorkbook.ActiveSheet.Cells.Copy newWorkbook.Worksheets(1).Cells ' 复用默认第一个工作表
    
    ' 保存并关闭工作簿
    Application.DisplayAlerts = False
    newWorkbook.SaveAs fileName:=filePath, FileFormat:=51 ' 51对应.xlsx格式
    Application.DisplayAlerts = True
    
    newWorkbook.Close SaveChanges:=False
    
    Set fso = Nothing
    Set newWorkbook = Nothing
End Sub

关键优化点 #

• 动态路径获取：用Environ("OneDriveCommercial")自动读取企业版OneDrive根路径，避免硬编码适配问题
• 目录容错处理：通过FileSystemObject确保目标文件夹存在，杜绝路径不存在报错
• 代码规范：补全变量类型声明，优化工作表复制逻辑，提升代码稳定性

实现每日自动运行 #

要完成每日自动保存，可通过两种方式：

• Excel内置定时：用Application.OnTime方法设置每日固定时间触发该宏
• Windows任务计划：创建定时任务，自动打开包含宏的Excel文件并执行对应程序

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