Ошибка времени выполнения: «91» при использовании application.quit - PullRequest
0 голосов
/ 14 апреля 2020
Sub Get_data()

Application.DisplayAlerts = False

On Error GoTo Handler:

'Range("E4").Select

Dim k As Long, L As Long

'k = InputBox("Please enter Sales start Date")


'L = InputBox("Please enter Sales End Date")


Dim conn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim sConnString As String


' Create the connection string.
'sConnString = "Provider=SQLOLEDB;Data Source=INSTANCE\SQLEXPRESS;" & _
              "Initial Catalog=NaranjeeDB;" & _
              "Integrated Security=SSPI;"

sConnString = "Provider=SQLOLEDB;Data Source=*****;Database=*****;User Id=***;Password=****;ConnenctionTimout=300;"


' Create the Connection and Recordset objects.
Set conn = New ADODB.Connection
Set rs = New ADODB.Recordset

' Open the connection and execute.
conn.Open sConnString
Set rs = conn.Execute("select s.sman_cd,s.Emp_name,i.itc_cd,i.itc_name,((sum(s.totqty)+sum(s.lzqty/fraction))*M.Conv_factor),Sum(s.amount) from salestransnew ('" & Range("AY1").Value & "','" & Range("AZ1").Value & "')s,itcatm I,stkm T,Item_Master M where s.itm_cd = t.itm_cd and i.itc_cd = t.itc_cd and S.Itm_cd = M.Itm_cd and Itg_Name in ('DABUR','FEM BEAUTY ITEMS') and convert(char,tran_dt,112) between '" & Format(Range("AY2").Value, "YYYYMMDD") & "' and '" & Format(Range("AZ2").Value, "YYYYMMDD") & "' group by s.sman_cd,s.Emp_name,i.itc_cd,i.itc_name,M.Conv_factor order by s.sman_cd")
'To Handle Run Time Error
Handler:

'Check connection is open or not.

If (conn.State And adStateOpen) = adStateOpen Then


'Check recordset is open or not.
If (rs.State And adStateOpen) = adStateOpen Then
    ' Check we have data.
    If Not rs.EOF Then
        ' Transfer result.
        Dim i As Long

        i = Range("A100000").End(xlUp).Row + 1
            Range("A" & i).CopyFromRecordset rs

            ' Close the recordset
            rs.Close
    Else
            'if no data in rs then close complete programme
            Sheets("Working").Visible = xlVeryHidden
            MsgBox "Error: Server is not responding" & vbCrLf & "Please try again."
            Application.Quit

    End If

Else
    'if rs is not open then close complete programme
    MsgBox "Error: Server is not responding" & vbCrLf & "Please try again."
    Application.Quit

End If

    ' Clean up
    If CBool(conn.State And adStateOpen) Then conn.Close
    Set conn = Nothing
    Set rs = Nothing

Else
    'if Conn is not open then close complete programme
    MsgBox "Error: Server is not responding" & vbCrLf & "Please try again."
    Application.Quit

End If
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...