Excel VBA调用SAP脚本时字符串无法自动复制的问题求助

我通过Excel VBA宏实现SAP自动化交易，流程为：从Excel长列表中复制销售订单号到SAP指定字段，点击相关按钮后将生成的合同号回写到Excel对应行。但当脚本遇到错误或处理耗时较长时，进入下一次循环后无法自动将销售订单号从Excel复制到SAP字段，仅在手动介入（如添加Stop语句后按F5）时才能成功复制。已尝试添加Wait和Sleep语句延长等待时间，但问题依旧，目前需处理2000条数据，希望实现无人值守运行，求助排查解决。

Sub ContractMacro()

Dim MyApplication As SAPFEWSELib.GuiApplication
Dim Connection As SAPFEWSELib.GuiConnection
Dim session As SAPFEWSELib.GuiSession
Dim SapGuiAuto As Object
Dim wb As Workbook
Dim currentso As Range
Dim contractrng As Range
Dim cell As Range
Dim x As Integer

Set SapGuiAuto = GetObject("SAPGUI").getscriptingengine
Set objGui = SapGuiAuto.getscriptingengine
Set objConn = objGui.Children(0)
Set session = objConn.Children(0)
Set wb = ThisWorkbook

Set contractrng = Range("A2:A" & WorksheetFunction.CountA(Range("A:A")))
Application.DisplayAlerts = False

session.findById("wnd[0]/usr/ctxtS_FKDAT-LOW").Text = "01.01." & Year(Date) - 1
For Each cell In contractrng
'    If Now >= Range("C4") And Now >= Range("C2") Then
'        Exit Sub
'    Else
'    End If
2
    session.findById("wnd[0]/usr/ctxtS_FKDAT-LOW").Text = "01.01." & Year(Date) - 1
    x = WorksheetFunction.CountA(Range("B:B")) + 1
    Set currentso = Cells(x, 1)
    If currentso = "" Then
        GoTo 4
    End If
    session.findById("wnd[0]/usr/ctxtS_AUBEL-LOW").Text = currentso
'************* line above does not carry over currentso************************ 
    If session.findById("wnd[0]/usr/ctxtS_AUBEL-LOW").Text = "" Then
    session.findById("wnd[0]/usr/ctxtS_AUBEL-LOW").Text = currentso
    Stop
    session.findById("wnd[0]/usr/ctxtS_AUBEL-LOW").Text = currentso
    Stop
    Else
    End If
'************** if statement above was added to manually make sure it's copied over***********
    On Error GoTo 3
    session.findById("wnd[0]/tbar[1]/btn[8]").press
    Select Case session.findById("wnd[0]/usr/shell").GetCellValue(0, "STATUS")
        Case Is = "A"
            session.findById("wnd[0]/usr/shell").setCurrentCell -1, ""
            session.findById("wnd[0]/usr/shell").SelectAll
            session.findById("wnd[0]/usr/shell").PressToolbarButton "ZIH20"
            session.findById("wnd[0]/tbar[1]/btn[8]").press
            session.findById("wnd[0]/usr/shell").setCurrentCell -1, ""
            session.findById("wnd[0]/usr/shell").SelectAll
            session.findById("wnd[0]/usr/shell").PressToolbarButton "VFLG"
            Cells(currentso.Row, 2) = session.findById("wnd[0]/usr/shell").GetCellValue(0, "SDAUFNR")
            session.findById("wnd[0]/tbar[0]/btn[3]").press
            session.findById("wnd[0]/tbar[0]/btn[3]").press
            session.findById("wnd[0]/tbar[0]/btn[3]").press
        Case Else
            Cells(currentso.Row, 2) = session.findById("wnd[0]/usr/shell").GetCellValue(0, "STATUS")
            session.findById("wnd[0]/tbar[0]/btn[3]").press
    End Select
    wb.Save
Next cell
4
Application.DisplayAlerts = True

Exit Sub

3
On Error GoTo -1
On Error Resume Next
Cells(currentso.Row, 2) = Trim(session.findById("wnd[1]/usr/txtMESSTXT1").Text)
session.findById("wnd[0]/tbar[0]/okcd").Text = "/N ZI_EW2_CONTROL"
session.findById("wnd[0]").SendVKey 0
GoTo 2
End Sub

1. 修复循环逻辑冲突 #

原代码同时使用For Each cell In contractrng遍历A列和x = WorksheetFunction.CountA(Range("B:B")) + 1获取行号，导致循环逻辑混乱，直接用遍历的cell作为当前销售订单号：

' 替换原循环内的行号获取逻辑
For Each cell In contractrng
    If cell.Value = "" Then Exit For
    Set currentso = cell
    ' 后续SAP操作代码...
Next cell

2. 添加SAP元素就绪等待函数 #

SAP控件未加载完成时直接赋值会失败，新增通用等待函数确保控件可交互：

Sub WaitForSAPElement(element As SAPFEWSELib.GuiElement, Optional timeoutSec As Integer = 10)
    Dim startTime As Date
    startTime = Now
    Do While Not element.Enabled Or Not element.Visible
        If DateDiff("s", startTime, Now) > timeoutSec Then
            Err.Raise vbObjectError + 1001, , "SAP元素等待超时"
        End If
        DoEvents
    Loop
End Sub

使用示例：

Dim soField As SAPFEWSELib.GuiTextField
Set soField = session.findById("wnd[0]/usr/ctxtS_AUBEL-LOW")
WaitForSAPElement soField
soField.SetFocus ' 先聚焦字段再赋值
soField.Text = currentso.Value

3. 优化错误处理流程 #

原错误处理中GoTo 2易导致状态混乱，改为回到当前循环重试，并确保SAP回到初始事务：

3
On Error GoTo -1
Dim errMsg As String
On Error Resume Next
errMsg = Trim(session.findById("wnd[1]/usr/txtMESSTXT1").Text)
On Error GoTo 0
Cells(currentso.Row, 2) = errMsg

' 强制回到初始事务
session.findById("wnd[0]/tbar[0]/okcd").Text = "/N ZI_EW2_CONTROL"
session.findById("wnd[0]").SendVKey 0
' 等待事务加载完成
WaitForSAPElement session.findById("wnd[0]/usr/ctxtS_FKDAT-LOW")
' 重新处理当前条目
Resume

4. 增加赋值验证与重试 #

若首次赋值失败，清空字段后重试：

If soField.Text <> currentso.Value Then
    soField.Text = ""
    soField.Text = currentso.Value
End If

5. 禁用Excel屏幕刷新 #

减少资源占用，避免交互卡顿：

' 循环开始前添加
Application.ScreenUpdating = False
' 循环结束后恢复
Application.ScreenUpdating = True

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