VBA-PCOMM宏单步执行(F8)正常，全速执行(F5)异常求助

看起来你遇到的问题非常典型——单步调试一切正常，但全速运行就出现代码跳过、循环异常甚至错误更新，核心原因大概率是Excel与PCOMM的执行不同步，再加上工作表对象引用不明确的隐患。下面分点给你具体的修复方案：

1. 先解决最致命的隐患：明确工作表对象引用 #

你的代码里大量使用Cells(i, "A")、Rows.Count这类未指定工作表的写法，默认会指向当前激活的工作表。当PCOMM窗口在执行过程中获得焦点时，Excel的ActiveSheet可能会意外切换，导致你取到错误的数据（甚至空值），进而引发无限循环或错误更新。

修复方法：把所有未指定工作表的单元格/行引用，都替换成你定义的appWs对象：

' 循环边界要指定工作表
For i = 2 To appWs.Cells(appWs.Rows.Count, "A").End(xlUp).Row Step 1
    ' 所有Cells调用都加上appWs前缀
    autECLPSObj.SendKeys appWs.Cells(i, "A").Value
    ' ... 其他所有Cells(i, "B")/Cells(i, "C")/Cells(i, "D")都改成appWs.Cells(...).Value
Next i

2. 优化PCOMM等待逻辑，确保同步 #

你虽然用了WaitForInputReady和WaitForAppAvailable，但等待的顺序和可靠性不足，导致Excel执行速度远超PCOMM的屏幕响应速度，后续指令被跳过。可以按以下方式优化：

调整等待顺序 #

发送按键指令后，应该先等待PCOMM应用就绪，再等待输入就绪，并且增加WaitForScreenSync确保屏幕完全更新：

autECLPSObj.SendKeys "[enter]"
autECLOIAObj.WaitForAppAvailable 10000 ' 增加超时时间，避免无限等待
autECLOIAObj.WaitForInputReady 10000
autECLPSObj.WaitForScreenSync ' 确保屏幕内容完全同步

更精准的等待：用WaitForString验证界面状态 #

比如在发送供应商代码后，不要只等属性，还可以验证输入的内容是否正确显示在对应位置，确保导航到了正确的页面：

' 输入供应商代码后，等待该位置的文本与输入一致
autECLPSObj.SendKeys appWs.Cells(i, "A").Value
autECLPSObj.WaitForString 6, 23, appWs.Cells(i, "A").Value, 10000
autECLOIAObj.WaitForInputReady 10000

统一封装等待逻辑（可选） #

可以写一个自定义的等待函数，减少重复代码，同时确保每一步都等待充分：

Sub WaitForPCOMMReady()
    Dim tempOIA As Object, tempPS As Object
    Set tempOIA = CreateObject("PCOMM.autECLOIA")
    Set tempPS = CreateObject("PCOMM.autECLPS")
    tempOIA.SetConnectionByHandle CreateObject("PCOMM.autECLConnList")(1).Handle
    tempPS.SetConnectionByHandle CreateObject("PCOMM.autECLConnList")(1).Handle
    
    tempOIA.WaitForAppAvailable 10000
    tempOIA.WaitForInputReady 10000
    tempPS.WaitForScreenSync
End Sub

然后在每次发送按键后调用：

autECLPSObj.SendKeys "[pf13]"
WaitForPCOMMReady

3. 修改后的完整代码示例 #

这里把上述修复点整合到你的代码中：

Sub email_upload()
    Dim appExcel As Excel.Application
    Dim appWb As Excel.Workbook
    Dim appWs As Excel.Worksheet
    Dim autECLConnMgrObj As Object
    Dim autECLOIAObj As Object
    Dim autECLSessionObj As Object
    Dim autECLPSObj As Object
    Dim autECLConnList As Object
    Dim FileSelected As String
    Dim fileName As String
    Dim i As Long

    ' 创建PCOMM连接对象
    Set autECLConnMgrObj = CreateObject("PCOMM.autECLConnMgr")
    Set autECLOIAObj = CreateObject("PCOMM.autECLOIA")
    Set autECLSessionObj = CreateObject("PCOMM.autECLSession")
    Set autECLPSObj = CreateObject("PCOMM.autECLPS")
    Set autECLConnList = CreateObject("PCOMM.autECLConnList")
    autECLConnList.Refresh ' 先刷新连接列表，再获取句柄
    autECLOIAObj.SetConnectionByHandle (autECLConnList(1).Handle)
    autECLPSObj.SetConnectionByHandle (autECLConnList(1).Handle)

    ' 选择模板文件
    With Application.FileDialog(1)
        .Title = "Please select a file to import!"
        .AllowMultiSelect = False
        If .Show <> -1 Then Exit Sub
        FileSelected = .SelectedItems(1)
    End With

    Set appExcel = Excel.Application
    Set appWb = appExcel.Workbooks.Open(fileName:=FileSelected)
    Set appWs = appWb.Worksheets("input")
    appExcel.Visible = True

    ' 提前等待PCOMM就绪
    autECLOIAObj.WaitForAppAvailable 10000

    ' 遍历模板行（明确指定appWs）
    With appWs
        For i = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row Step 1
            ' 导航到供应商代码输入位置
            autECLPSObj.SetCursorPos 6, 23
            autECLPSObj.SendKeys .Cells(i, "A").Value
            ' 验证输入是否显示正确
            autECLPSObj.WaitForString 6, 23, .Cells(i, "A").Value, 10000
            WaitForPCOMMReady

            autECLPSObj.SendKeys "[enter]"
            WaitForPCOMMReady

            autECLPSObj.SendKeys "[pf13]"
            WaitForPCOMMReady

            autECLPSObj.SendKeys "[pf10]"
            WaitForPCOMMReady

            ' 输入相关信息
            autECLPSObj.SetCursorPos 13, 24
            autECLPSObj.SendKeys .Cells(i, "B").Value
            autECLPSObj.WaitForString 13, 24, .Cells(i, "B").Value, 10000
            WaitForPCOMMReady

            autECLPSObj.SendKeys "[enter]"
            WaitForPCOMMReady

            autECLPSObj.SendKeys "[pf8]"
            WaitForPCOMMReady

            ' 处理邮箱前缀
            autECLPSObj.SetCursorPos 13, 21
            If .Cells(i, "C").Value = "" Then
                autECLPSObj.SendKeys "1"
                autECLPSObj.WaitForString 13, 21, "1", 10000
            Else
                autECLPSObj.SendKeys .Cells(i, "C").Value
                autECLPSObj.WaitForString 13, 21, .Cells(i, "C").Value, 10000
            End If
            WaitForPCOMMReady

            ' 输入邮箱地址
            autECLPSObj.SetCursorPos 21, 1
            autECLPSObj.SendKeys .Cells(i, "D").Value
            autECLPSObj.WaitForString 21, 1, .Cells(i, "D").Value, 10000
            WaitForPCOMMReady

            autECLPSObj.SendKeys "[pf8]"
            WaitForPCOMMReady

            autECLPSObj.SendKeys "[pf12]"
            WaitForPCOMMReady

            autECLPSObj.SendKeys "[pf12]"
            WaitForPCOMMReady
        Next i
    End With

    appWb.Close SaveChanges:=False
    MsgBox ("Input done!")
End Sub

' 自定义等待函数
Sub WaitForPCOMMReady()
    Dim tempOIA As Object, tempPS As Object
    Set tempOIA = CreateObject("PCOMM.autECLOIA")
    Set tempPS = CreateObject("PCOMM.autECLPS")
    tempOIA.SetConnectionByHandle CreateObject("PCOMM.autECLConnList")(1).Handle
    tempPS.SetConnectionByHandle CreateObject("PCOMM.autECLConnList")(1).Handle
    
    tempOIA.WaitForAppAvailable 10000
    tempOIA.WaitForInputReady 10000
    tempPS.WaitForScreenSync
End Sub

额外调试建议 #

• 如果还是有问题，可以在循环里加入日志，把每一步的操作和读取的数据写入Excel的另一个工作表，方便排查哪一步出了问题：

  appWs.Parent.Worksheets("Log").Cells(i, 1).Value = "Processing row " & i & ": " & .Cells(i, "A").Value
  

• 暂时增加Sleep函数（需要声明API）来强制等待，验证是否是同步问题：

  ' 放在模块顶部
  Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
  ' 发送按键后调用
  Sleep 500 ' 等待500毫秒
  

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