Office2016迁移至O365后SAP BPC上传VBA弹窗不弹出问题求助

原有适配Office 2016、用于将桌面文件上传至SAP BPC服务器并触发Data Manager包的VBA代码，迁移至O365后出现异常：EPM.DataManagerOpenFileUploadDialog执行完成文件上传后，后续的确认弹窗未弹出，后续逻辑完全中断。

1. O365升级了VBA运行安全机制，未做异常捕获的代码遇到运行时错误会直接静默退出，无任何提示
2. SAP EPM插件在O365环境下的DataManagerOpenFileUploadDialog方法从同步阻塞改为异步执行，旧代码未做适配会导致后续逻辑执行时序错乱
3. 旧代码使用ActiveWorkbook获取工作簿路径，O365多窗口场景下容易出现指向错误，触发路径异常后代码崩溃
4. 固定使用文件号#1的写法容易出现文件占用冲突，触发运行时错误

Sub LaunchMassiveUpload()
    ' 新增错误捕获，避免异常静默退出
    On Error GoTo ErrHandler
    
    Dim objPackageFromSheet As New ADMPackage
    Dim suffix As String
    Dim fileSuffix As String
    Dim fileName As String
    Dim user As String
    Dim chainId As String
    Dim pkgPath As String
    Dim pkgDesc As String
    Dim pkgId As String
    Dim pkgType As String
    Dim teamId As String
    Dim usrGroup As String

    suffix = Right(Application.Caller, 4)
    fileSuffix = Range("FILE_SUFFIX" & suffix).Value
    user = Range("USER").Value
    fileName = user & fileSuffix & ".csv"

    MsgBox "Please name the file " & fileName & " and upload it to the ""Private"" folder (menu on the left)." & vbCrLf & _
    "If the file is uploaded anywhere else, data will not be loaded in BPC.", vbInformation, "Info"
    EPM.DataManagerOpenFileUploadDialog
    
    ' 适配O365 EPM异步执行逻辑，等待上传操作完全完成
    Dim waitCnt As Integer
    For waitCnt = 1 To 3
        DoEvents
        Application.Wait Now + TimeValue("00:00:01")
    Next waitCnt

    If MsgBox("Do you want to Copy the last " & fileName & " loaded file into BPC ?", vbYesNo, "Confirm") = vbYes Then
        Dim path As String
        Dim nam As String
        ' 替换ActiveWorkbook为ThisWorkbook，明确指向当前代码所在工作簿
        path = ThisWorkbook.FullName
        nam = ThisWorkbook.Name

        path = Replace(path, nam, "")
        path = path & Range("USER").Value & suffix
        
        ' 动态获取可用文件号，避免固定文件号冲突
        Dim fNum As Integer
        fNum = FreeFile()
        Open path For Output As #fNum
        Write #fNum, ""
        Close #fNum

        objPackageFromSheet.fileName = Range("CHAIN_ID" & suffix).Value
        objPackageFromSheet.groupId = Range("PATH" & suffix).Value
        objPackageFromSheet.PackageDesc = Range("PACKAGE_DESC" & suffix).Value
        objPackageFromSheet.packageId = Range("PACKAGE_ID" & suffix).Value
        objPackageFromSheet.PackageType = Range("PACKAGE_TYPE" & suffix).Value
        objPackageFromSheet.teamId = Range("TEAM_ID" & suffix).Value
        objPackageFromSheet.UserGroup = Range("USER_GROUP" & suffix).Value

        epm_dm_api.RunPackage objPackageFromSheet, path

        If MsgBox("File Upload Triggered. Do you want to check Status ?", vbYesNo, "Confirm") = vbYes Then
            EPM.DataManagerOpenViewStatusDialog
        End If
    End If
    
    Exit Sub
ErrHandler:
    ' 异常时弹出明确错误提示，方便问题排查
    MsgBox "运行错误：" & Err.Number & vbCrLf & "错误信息：" & Err.Description, vbCritical, "执行失败"
End Sub

1. 新增的错误捕获逻辑会在代码异常时弹出明确提示，不会再出现静默退出的情况
2. 加入的3秒等待+DoEvents逻辑适配了O365下EPM插件的异步执行特性，确保上传操作完全完成后再弹出后续确认框
3. 路径获取逻辑修改为明确指向当前代码所在工作簿，避免多窗口场景下路径错误
4. 动态文件号的使用避免了文件占用导致的运行时错误

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