Как вставить окно сообщения для обработки ошибок во время выполнения в VBA для MS Excel - PullRequest
Новая
       40

Как вставить окно сообщения для обработки ошибок во время выполнения в VBA для MS Excel

0 голосов
/ 22 января 2019

Мой код работает нормально, если что-то выбрано из выпадающего списка и макрос запущен.

Но если ничего не выбрано, что никогда не должно иметь место, я получаю ошибку времени выполнения Неверное имя столбца.

Вместо этого я хочу, чтобы в окне сообщения появилось сообщение «Убедитесь, что X выбран из выпадающего меню» кнопкой ОК вместо указанной ошибки времени выполнения.

Ошибка возникает в строке ниже, которую я нашел при отладке:

rs1.Open 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 возвращает идентификатор, если что-то выбрано из выпадающего списка, и код будет работать. Если в выпадающем списке ничего не выбрано, GG - это какой-то текст, который приводит к сбою кода на
rs1.Open sqlstrSchemeDetail, DBCONT

Ответы [ 2 ]

0 голосов
/ 22 января 2019

Спасибо всем за ваш вклад. Как и советовали, я поймал ошибку ранее. Я сделал это, сказав, что если sqlstring = x, то MsgBox y и выйти из sub, иначе продолжить открывать набор записей ... 

If GG = "2. Select Selection" Then
MsgBox "Please Pick a Selection"

Exit Sub

Else Call connectDatabase 'Debug.Print sqlstrSel

            rs1.Open sqlstrSchemeDetail, DBCONT

           ' 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
End If
0 голосов
/ 22 января 2019

Создание пользовательской метки обработки ошибок. 

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
...