Sub ВыполнитьКоманду(ByVal drkt As String, ByVal sq As String, ByVal tip As Byte)
On Error GoTo errline
Set cn = New ADODB.Connection
cn.Mode = adModeReadWrite
'cn.Mode = adModeShareExclusive
Set rs = New ADODB.Recordset
Set cmd = New ADODB.Command
Select Case tip
Case  1 
  cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & drkt & ";" & _
  "Extended Properties=dBASE IV"
Case  2 
  cn.Open "Provider=vfpoledb;Data Source=" & drkt & ";" & _
  "Collating Sequence=russian"
Case  3 
  cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & drkt & ";" & _
  "Extended Properties='Excel 8.0;HDR=Yes;IMEX=1'"
End Select
  cmd.CommandType = adCmdText
  cmd.CommandText = sq
  cmd.ActiveConnection = cn
  cmd.Execute
'cn.Execute sq, , adCmdText + adExecuteNoRecords
Set cmd = Nothing
cn.Close
Set cn = Nothing
Exit Sub
errline:
errmsg = ""
For Each adoerr In cn.Errors
  errmsg = errmsg & vbCr & "Номер ошибки: " & CStr(adoerr.Number)
  errmsg = errmsg & vbCr & "Описание ошибки: " & adoerr.Description
Next
MsgBox errmsg
End Sub