excel - 如何在MS Excel的VBA中插入用于运行时错误处理的消息框

Question

如果从下拉列表中选择某项并运行宏，则我的代码可以正常工作。

但是，如果什么也没选择，那就永远不会发生，我会收到运行时错误无效的列名。

取而代之的是，我希望一个msg框使用“确定”按钮说“确保从下拉列表中选择X”，而不是所说的运行时错误。

错误发生在我在调试中找到的以下行:

rs1。打开sqlstrSchemeDetail，DBCONT

发生错误的原因是，如果未选择任何内容，则无法创建sql字符串。

Call connectDatabase

rs1.Open sqlstrSchemeDetail, DBCONT  'WHERE ERROR HAPPENS

'Debug.Print sqlstrSel
Debug.Print sqlstrSchemeDetail

For intColIndex = 0 To rs1.Fields.Count - 1
    Sheet2.Range("A1").Offset(0, intColIndex).Value = rs1.Fields(intColIndex).Name
Next

Sheet2.Range("A2").CopyFromRecordset rs1

'rs.Close
'Set rs = Nothing

Call closeDatabase

这是DBCONT

Public Function connectDatabase()
Set DBCONT = CreateObject("ADODB.Connection")
Dim sConn As String
sConn = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=True;Initial Catalog=PamwinPlusLIVE;Data Source=GS1NHHMSQLV04\INST04;Use Procedure for Prepare=1;Auto Translate=True;Packet Size=4096;Workstation ID=SL1NHHMCTXV108;Use Encryption for Data=False;Tag with column collation when possible=False"

 DBCONT.Open sConn
 DBCONT.cursorlocation = 3

End Function

更进一步

Dim sqlstrSchemeDetail As String
sqlstrSchemeDetail = "Select scheme.SchemeID, DevOfficer.Description [Scheme 
Owner], scheme.Description [Scheme Description], scheme.Version [v.], 
Status.Description [Status], TenureType.Description [Tenure Type], 
Template.Description [Template], Units.Units,scheme.lastupdatedDate 
[Updated] from scheme inner join Status on scheme.Status = status.StatusID 
inner join TenureType on scheme.TenureTypeID = TenureType.TenureTypeID inner 
join DevOfficer on scheme.devofficer = devofficer.devofficerid inner join 
SelScheme ON Scheme.SchemeID = SelScheme.SchemeID  inner join Template on 
scheme.TemplateID = template.templateid inner join (select 
scheme.SchemeID,sum(units) as Units from Property inner join scheme on 
Property.SchemeID = scheme.SchemeID group by scheme.SchemeID) Units on 
Units.schemeid = scheme.schemeid where scheme.masterSchemeID is null and 
SelScheme.SelID =" & GG

Dim GG As String
GG = Split(Sheet1.ComboBox1.Value, "-")(0)

如果从下拉框中选择了某些内容，GG将返回一个ID，然后该代码将起作用。如果在下拉框中未选择任何内容，则GG是一些文本，使代码无法通过
rs1。打开sqlstrSchemeDetail，DBCONT

Answer 1

创建一个自定义错误处理标签。

sub main()

    on error goto found_error
    Call connectDatabase
                    rs1.Open sqlstrSchemeDetail, DBCONT  --WHERE ERROR HAPPENS
                    'Debug.Print sqlstrSel
                    Debug.Print sqlstrSchemeDetail
                    For intColIndex = 0 To rs1.Fields.Count - 1
                    Sheet2.Range("A1").Offset(0, intColIndex).Value = rs1.Fields(intColIndex).Name
     Next

                    Sheet2.Range("A2").CopyFromRecordset rs1

     'rs.Close
      'Set rs = Nothing
     Call closeDatabase

    exit sub

found_error:
    msgbox err.number & chr(10) & err.description & chr(10) & sqlstrSchemeDetail & chr(10) & sqlstrSel

end sub