Excel VBA调用Access表单传参返回结果报错求助

问题描述 #

• 需求：通过Excel VBA将4个参数传入Access表单frmTrmVl，按指定流程执行后返回2个结果，用于批量处理Excel多行数据
• 表单执行流程：
  1. 非绑定文本框cmbEntry输入"Conn PN"，执行qryCmbPinNumber、qryCmbCAVNOLst查询
  2. 非绑定文本框cmbPinNmbr输入"Cav No"，执行qryCmbLst、qryWrSzOptns、qryCmbEntryLst查询
  3. 非绑定组合框cmbx_trmlProperty输入"Terminal Type"，执行qryCBLSEALPNCONV、qryWrCblSeal、qryWrSZRng1查询
  4. 非绑定文本框txtbox_WrSz输入"Wire Size"，执行qryTERMPNCONV、qryWrSzRng查询，结果存入txtbx_trmnlPN、txtbx_MinWr、txtbx_MaxWr、txtbx_cblseal
• 遇到的错误：
  • 初始代码触发「Object-variable or With block variable not set」
  • 调整后出现#2110（无法将焦点移至cmbPinNmbr控件）及40036（Forms对象的Item方法失败）

错误原因分析 #

1. 初始代码用db.OpenForm打开表单是错误操作，Access表单需通过DoCmd.OpenForm打开，该方法属于Access应用对象，而非数据库对象
2. 调整后的代码存在控件名称拼写错误：FRM.Controls("ccmbx_TrmlPrprty")应为FRM.Controls("cmbx_TrmlPrprty")
3. 控件处于隐藏状态时无法设置焦点：表单初始状态下cmbPinNmbr等控件是隐藏的，直接设置焦点会触发2110错误，应依赖控件的AfterUpdate事件自动显示后续控件，而非手动设置焦点
4. 关闭表单后读取控件值会导致对象已释放，引发变量未设置错误

修复后的代码 #

Excel VBA代码（支持批量处理） #

Option Explicit

Sub Term_PN_Batch()
    Dim Result1 As String
    Dim Result2 As String
    Dim AccessApp As Object ' 后期绑定，无需引用Access库
    Dim FRM As Object
    Dim i As Integer ' 批量处理循环变量
    
    ' 启动Access并打开目标数据库
    Set AccessApp = CreateObject("Access.Application")
    AccessApp.OpenCurrentDatabase "C:\Users\t0989sp\Documents\Engineering\FCA_Terminal_Values_R5 WITH CABLE SEAL_REMOTE_PLAY.accdb"
    
    ' 后台打开表单（无需显示界面）
    AccessApp.DoCmd.OpenForm "frmTrmVl", WindowMode:=1 ' 1对应acHidden常量
    Set FRM = AccessApp.Forms("frmTrmVl")
    
    ' 批量处理Sheet1中A1:D10的4列参数，可根据实际范围调整
    For i = 1 To 10
        ' 按流程设置参数并手动触发对应事件，确保控件状态更新
        FRM.Controls("cmbEntry").Value = ThisWorkbook.Sheets("Sheet1").Range("A" & i).Value
        FRM.cmbEntry_AfterUpdate
        
        FRM.Controls("cmbPinNmbr").Value = ThisWorkbook.Sheets("Sheet1").Range("B" & i).Value
        FRM.cmbPinNmbr_AfterUpdate
        
        FRM.Controls("cmbx_TrmlPrprty").Value = ThisWorkbook.Sheets("Sheet1").Range("C" & i).Value
        FRM.cmbx_TrmlPrprty_AfterUpdate
        
        FRM.Controls("txtbox_WrSz").Value = ThisWorkbook.Sheets("Sheet1").Range("D" & i).Value
        FRM.txtbx_WrSz_AfterUpdate
        
        ' 读取结果并写入Excel对应行
        Result1 = FRM.Controls("txtbx_trmnlPN").Value
        Result2 = FRM.Controls("txtbx_cblseal").Value
        ThisWorkbook.Sheets("Sheet1").Range("E" & i).Value = Result1
        ThisWorkbook.Sheets("Sheet1").Range("F" & i).Value = Result2
    Next i
    
    ' 清理资源
    AccessApp.DoCmd.Close 2, "frmTrmVl" ' 2对应acForm常量
    AccessApp.Quit
    Set FRM = Nothing
    Set AccessApp = Nothing
End Sub

优化后的Access表单代码 #

Option Compare Database
Option Explicit

Private Sub cmbEntry_AfterUpdate()
    Me.cmbPinNmbr.Requery
    Me.cmbPinNmbr.Visible = True
    Me.lbl_PinNmbr.Visible = True
    Me.cmbPinNmbr.Value = ""
    Me.cmbx_TrmlPrprty.Value = ""
    Me.txtbx_WrSz.Value = ""
    ResetResultControls
End Sub

Private Sub cmbPinNmbr_AfterUpdate()
    Me.cmbx_TrmlPrprty.Visible = True
    Me.lbl_TrmlPrprty.Visible = True
    Me.cmbx_TrmlPrprty.Value = ""
    Me.txtbx_WrSz.Value = ""
    ResetResultControls
End Sub

Private Sub cmbx_TrmlPrprty_AfterUpdate()
    Me.txtbx_WrSz.Visible = True
    Me.lbl_WrSz.Visible = True
    Me.txtbx_WrSz.Value = ""
    ResetResultControls
    Me.cmd_WrRngbttn.Visible = True
End Sub

Private Sub cmdClr_Click()
    Me.cmbEntry.Value = ""
    Me.cmbPinNmbr.Value = ""
    Me.cmbx_TrmlPrprty.Value = ""
    Me.txtbx_WrSz.Value = ""
    
    Me.cmbPinNmbr.Visible = False
    Me.lbl_PinNmbr.Visible = False
    Me.cmbx_TrmlPrprty.Visible = False
    Me.lbl_TrmlPrprty.Visible = False
    Me.txtbx_WrSz.Visible = False
    Me.lbl_WrSz.Visible = False
    Me.cmd_WrRngbttn.Visible = False
    ResetResultControls
End Sub

Private Sub txtbx_WrSz_AfterUpdate()
    Me.txtbx_trmnlPN.Requery
    Me.txtbx_MinWr.Requery
    Me.txtbx_MaxWr.Requery
    
    Me.lbl_Rslts.Visible = True
    Me.lbl_trmnlPN.Visible = True
    Me.lbl_MinWr.Visible = True
    Me.lbl_MaxWr.Visible = True
    Me.txtbx_trmnlPN.Visible = True
    Me.txtbx_MinWr.Visible = True
    Me.txtbx_MaxWr.Visible = True
    Me.txtbx_cblseal.Visible = True
End Sub

' 提取重复的结果控件重置逻辑，简化代码
Private Sub ResetResultControls()
    Me.lbl_Rslts.Visible = False
    Me.lbl_trmnlPN.Visible = False
    Me.txtbx_trmnlPN.Visible = False
    Me.lbl_MinWr.Visible = False
    Me.lbl_MaxWr.Visible = False
    Me.txtbx_MinWr.Visible = False
    Me.txtbx_MaxWr.Visible = False
    Me.txtbx_cblseal.Visible = False
End Sub

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