VBA.Mania

Option Explicit
Sub ImportDanych(ByVal MyConn As String, _
                 ByVal sID As String, _
                 Target As Excel.Range)
    On Error GoTo ImporDanyc_Error

    Dim Cnn As ADODB.Connection
    Dim Rst As ADODB.Recordset
    Dim sSQL As String
    Dim FinalRow As Long

    sSQL = "SELECT IDartykulu, nr_artykulu, Opis, Ilosc, Nr_atestu FROM nazwa_tabeli "
    sSQL = sSQL & " WHERE IDartykulu=" & sID
   ' Call ScreenCalcEvents(False)
    Set Cnn = New ADODB.Connection
    With Cnn
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .CursorLocation = adUseClient
        .Open MyConn
    End With
    Set Rst = New ADODB.Recordset
    With Rst
        .CursorType = adOpenStatic
        .LockType = adLockReadOnly
        Set .ActiveConnection = Cnn
        .Open sSQL, , , , adCmdText
        FinalRow = 1
        Target.Cells(1, 1).Resize(, 5) = Array("ID", "Nr artykułu", "Opis", "Ilość", "Nr atestu")
        If Not (.BOF And .EOF) Then    ' to jest info ze nie ma Recs
            Target.Cells(1, 1).Offset(1, 1).CopyFromRecordset Rst
            .MoveLast        ' bo jest EOF
            FinalRow = .RecordCount
        End If
        .Close
    End With
    Set Rst = Nothing
    Cnn.Close
    Set Cnn = Nothing
    If FinalRow = 1 Then
        ' ....
        MsgBox "Brak danych"
    Else
        MsgBox FinalRow
    End If

    '---------------------
ImporDanyc_Exit:
    On Error Resume Next
    Call CloseRSObject(Rst)
    Call CloseRSObject(Cnn)
    ' Call ScreenCalcEvents(True)
    Exit Sub

ImporDanyc_Error:
    MsgBox "Błąd : ( " & Err.Number & " ) " & Err.Description & vbCrLf & _
           "Procedura : " & "ImporDanyc", vbExclamation
    Resume ImporDanyc_Exit
End Sub

'--------------------------------------------
Public Sub CloseConObject(Cnn As ADODB.Connection)
    On Error Resume Next
    If Not (Cnn Is Nothing) Then
        If Cnn.State = adStateOpen Then Cnn.Close
        Set Cnn = Nothing
    End If
End Sub

Public Sub CloseRSObject(Rs As ADODB.Recordset)
    On Error Resume Next
    If Not (Rs Is Nothing) Then
        With Rs
            If CBool(.State And adStateOpen) Then
                If .EditMode <> adEditNone Then .CancelUpdate
                .Close
            End If
        End With
        Set Rs = Nothing
    End If
End Sub

Public Sub ScreenCalcEvents(Optional ByVal bTrue As Boolean)
    On Error Resume Next
    With Application
        If bTrue Then
            .EnableEvents = True
            .Calculation = xlCalculationAutomatic
            .ScreenUpdating = True
        Else
            .ScreenUpdating = False
            .Calculation = xlCalculationManual
            .EnableEvents = False
        End If
    End With
End Sub