Sub Makro1()
'
' Tastenkombination: Strg+q
'
    MsgBox ("Start")
 
    Dim db_rated As ADODB.Connection
    Set db_rated = New ADODB.Connection
    db_rated.Open "Provider=MSDASQL;DSN=web1_rated"
 
    Dim result As Recordset
    Set result = New ADODB.Recordset
 
    result.Open "SELECT ddi FROM ddi_table WHERE no='858555' AND valid_to >" & _
      "NOW()", db_rated
 
    If result.RecordCount > 0 Then
      MsgBox CStr(result("ddi"))
    End If
 
    If result.RecordCount <= 0 Then
      MsgBox ("keine ddi gefunden ")
    End If
 
    result.Close
    Set result = Nothing
 
    db_rated.Close
    Set db_rated = Nothing
 
End Sub