Public Declare Function SQLConfigDataSource Lib "ODBCCP32.DLL" (ByVal hwndParent As Long, ByVal fRequest As Long, ByVal lpszDriver As String, ByVal lpszAttributes As String) As Long

Function CreateDSN(StrCnn As String, _
              Optional sDriver As String = "", _
              Optional hWnd As Long =  0 &, _
              Optional Oper As long = ODBC_ADD_SYS_DSN  ) As long
'ODBC_ADD_SYS_DSN = 4

Dim sCnn As String, TestCnn As ADODB.Connection, i  As Long, intRet As Long

'Set the attributes delimited by null. See driver documentation for a complete list of supported attributes.
sCnn = ReplaceAll(StrCnn, ";", Chr$( 0 )) ' замена ; на 0

intRet = SQLConfigDataSource(hWnd, Oper, sDriver, sCnn)

CreateModiDSN = IIf(intRet,  1 , - 1 )

If CreateModiDSN = - 1  Then
 Err.Raise vbObjectError +  1 , , "Ошибка при создании/модификации DSN"
Else
 i =  1  
 On Error GoTo  1 
  Set TestCnn = New ADODB.Connection
  TestCnn.Open StrCnn
  TestCnn.Close
 Debug.Print "i=" & i 
 Exit Function
  1 :            ' вот здесь может накручивать счетчки до 9000 ( это от 100 до 1000 msec)
 i = i +  1 
 Resume
End If
end function

 i =  1  
 On Error GoTo  1 
  Set TestCnn = New ADODB.Connection
  TestCnn.Open StrCnn
  TestCnn.Close
 Debug.Print "i=" & i 
 Exit Function
  1 :            ' вот здесь может накручивать счетчки до 9000 ( это от 100 до 1000 msec)
 i = i +  1 
 Resume

Public Declare Function SQLConfigDataSource Lib "ODBCCP32.DLL" (ByVal hwndParent As Long, ByVal fRequest As Long, ByVal lpszDriver As String, ByVal lpszAttributes As String) As Long

' Перед вызовом удалить DSN TestExcel, если он есть
Function CreateDSNTest() As Object
Dim StrCnn As String, drvName As String
' попытка коннекта (считая , что DSN is valid ) --------------
On Error GoTo ErrH
Set Cnn = New ADODB.Connection
' Какой-ни реальный SLS файл :
StrCnn = "DSN=TestExcel;Driver={Microsoft Excel Driver (*.xls)};" & _
         "DriverId=790;Dbq=C:\1\Книга1.XLS;"
Cnn.ConnectionString = StrCnn
Cnn.Open
Set CreateDSNTest = Cnn
Exit Function ' -->>' выход при удаче -->>

ErrH:  '  ошибка из-за отсутствия DSN или по другим причинам
Debug.Print Cnn.State, Err.Description, Cnn.Errors.Count

' Если этого (или Set Cnn=Nothing) не сделать, в след функции невозможно будет с 1 раза
' протестировать DSN (придется делать от 100 до 1000 попыток ) :
'Set Cnn = New ADODB.Connection  ' ни On Error Goto 0 ни Err.Clear, Cnn.Errors.Clear - не помогают !
On Error GoTo  [b]0 
Err.Clear
Cnn.Errors.Clear[/b]

' неудача из-за того, что  DSN не создан - попытка создания DSN ---------------
drvName = "Microsoft Excel Driver (*.xls)"
CreateDSN StrCnn, drvName, ,  4 

' DSN удачно создан - Вторая и Последняя попытка коннекта после свежесозданного DSN
Set Cnn = New ADODB.Connection ' елси этого не сделать, то будет в след строке ошибка
Cnn.ConnectionString = StrCnn
Cnn.Open
Set CreateDSNTest = Cnn

End Function
Function CreateDSN(StrCnn As String, _
              Optional sDriver As String = "", _
              Optional hWnd As Long =  0 &, _
              Optional Oper As Long =  4 ) As Long
'ODBC_ADD_SYS_DSN = 4

Dim sCnn As String, TestCnn As ADODB.Connection, i  As Long, intRet As Long, sa() As String

'Set the attributes delimited by null. See driver documentation for a complete list of supported attributes.
sa = Split(StrCnn, ";")
sCnn = ""
For i =  0  To UBound(sa)
 sCnn = sCnn & IIf(i =  0 , "", Chr$( 0 )) & sa(i)
Next i

intRet = SQLConfigDataSource(hWnd, Oper, sDriver, sCnn)

CreateDSN = IIf(intRet,  1 , - 1 )

If CreateDSN = - 1  Then ' Сюда в тесте никогда не приходим
 Err.Raise vbObjectError +  1 , , "Ошибка при создании/модификации DSN"
Else
 i =  1 
 On Error GoTo  1 
  Set TestCnn = New ADODB.Connection
  TestCnn.Open StrCnn
  TestCnn.Close
  Set TestCnn = Nothing
  Debug.Print "i=" & i
  Exit Function
 1 :             ' вот здесь может накручивать счетчки до 9000 ( это от 100 до 1000 msec)
 i = i +  1 
 Resume
End If
End Function

Если этого (или Set Cnn=Nothing) не сделать, в след функции невозможно будет с 1  раза
' протестировать DSN (придется делать от 100 до 1000 попыток ) :
'Set Cnn = New ADODB.Connection  ' ни On Error Goto 0 ни Err.Clear, Cnn.Errors.Clear - не помогают !
On Error GoTo  0 
Err.Clear
Cnn.Errors.Clear

Private Declare Function SQLConfigDataSource Lib "ODBCCP32.DLL" (ByVal hwndParent As Long, ByVal fRequest As Long, ByVal lpszDriver As String, ByVal lpszAttributes As String) As Long

' Перед вызовом удалить DSN TestExcel, если он есть
Function ExecTest()
Dim Cnn As ADODB.Connection, Cmd As ADODB.Command
Dim StrCnn As String

Set Cnn = New ADODB.Connection
' Какой-ни реальный XLS файл :
ThisName = ThisWorkbook.Path & "\" & ThisWorkbook.Name
' Этот пройдет :
'StrCnn = "DSN=TestExcel;Driver={Microsoft Excel Driver (*.xls)};" & _
         "DriverId=790;Dbq=" & ThisName & ";"
' а здесь ошибка будет:
StrCnn = "Driver={Microsoft Excel Driver (*.xls)};" & _
         "DriverId=790;Dbq=" & ThisName & ";"

Cnn.ConnectionString = StrCnn
Cnn.Open
Set Cmd = New ADODB.Command
Set Cmd.ActiveConnection = Cnn
Cmd.CommandType = adCmdText
Cmd.CommandText = "UPDATE Tbl1 SET h1=2"
Cmd.Execute
End Function

' Перед вызовом удалить DSN TestExcel, если он есть
Function CreateDSNTest() As Object
Dim Cnn As ADODB.Connection
Set Cnn = New ADODB.Connection
Dim StrCnn As String, drvName As String
' попытка коннекта (считая , что DSN is valid ) --------------
On Error GoTo ErrH
Set Cnn = New ADODB.Connection
' Какой-ни реальный SLS файл :
ThisName = ThisWorkbook.Path & "\" & ThisWorkbook.Name
StrCnn = "DSN=TestExcel;Driver={Microsoft Excel Driver (*.xls)};" & _
         "DriverId=790;Dbq=" & ThisName & ";"
Cnn.ConnectionString = StrCnn
Cnn.Open
Set Cmd = New ADODB.Command
Set Cmd.ActiveConnection = Cnn
Cmd.CommandType = adCmdText
Cmd.CommandText = "CREATE " + Str1 + " " + Str2
Cmd.Execute
Set CreateDSNTest = Cnn
Exit Function ' -->>' выход при удаче -->>

ErrH:  '  ошибка из-за отсутствия DSN или по другим причинам
Debug.Print Cnn.State, Err.Description, Cnn.Errors.Count

' Если этого (или Set Cnn=Nothing) не сделать, в след функции невозможно будет с 1 раза
' протестировать DSN (придется делать от 100 до 1000 попыток ) :
'Set Cnn = New ADODB.Connection  ' ни On Error Goto 0 ни Err.Clear, Cnn.Errors.Clear - не помогают !
'On Error GoTo 0
'Err.Clear
'Cnn.Errors.Clear

' неудача из-за того, что  DSN не создан - попытка создания DSN ---------------
drvName = "Microsoft Excel Driver (*.xls)"
CreateDSN StrCnn, drvName, ,  4 

' DSN удачно создан - Вторая и Последняя попытка коннекта после свежесозданного DSN
Set Cnn = New ADODB.Connection ' елси этого не сделать, то будет в след строке ошибка
Cnn.ConnectionString = StrCnn
Cnn.Open
Set CreateDSNTest = Cnn

End Function
Function CreateDSN(StrCnn As String, _
              Optional sDriver As String = "", _
              Optional hWnd As Long =  0 &, _
              Optional Oper As Long =  4 ) As Long
'ODBC_ADD_SYS_DSN = 4

Dim sCnn As String, TestCnn As ADODB.Connection, i  As Long, intRet As Long, sa() As String

'Set the attributes delimited by null. See driver documentation for a complete list of supported attributes.
sa = Split(StrCnn, ";")
sCnn = "": StrCnn = ""
For i =  0  To UBound(sa)
 sCnn = sCnn & IIf(i =  0 , "", Chr$( 0 )) & sa(i)
 If Not UCase(Left(sa(i),  7 )) = "DRIVER=" Then
 ' sCnn = sCnn & IIf(i = 0, "", Chr$(0)) & sa(i)
  StrCnn = StrCnn & IIf(i =  0 , "", ";") & sa(i)
 End If
Next i
If Right(StrCnn,  1 ) <> ";" Then StrCnn = StrCnn & ";"

intRet = SQLConfigDataSource(hWnd, Oper, sDriver, sCnn) ' sDriver

CreateDSN = IIf(intRet,  1 , - 1 )

If CreateDSN = - 1  Then ' Сюда в тесте никогда не приходим
 Err.Raise vbObjectError +  1 , , "Ошибка при создании/модификации DSN"
Else
 i =  1 
 On Error GoTo  1 
  Set TestCnn = New ADODB.Connection
  TestCnn.Open StrCnn
  TestCnn.Close
  Set TestCnn = Nothing
  Debug.Print "i=" & i
  Exit Function
 1 :             ' вот здесь может накручивать счетчки до 9000 ( это от 100 до 1000 msec)
 i = i +  1 
 Resume
End If
End Function

Windows Registry Editor Version  5 . 00 

[HKEY_LOCAL_MACHINE\SOFTWARE\ODBC\ODBC.INI\TestExcel]
"Driver"="C:\\WINNT\\system32\\odbcjt32.dll"
"DBQ"="C:\\Documents and Settings\\kefi\\Мои документы\\Книга1.xls"
"DriverId"=dword: 00000316 
"SafeTransactions"=dword: 00000000 
"UID"=""

[HKEY_LOCAL_MACHINE\SOFTWARE\ODBC\ODBC.INI\TestExcel\Engines]

[HKEY_LOCAL_MACHINE\SOFTWARE\ODBC\ODBC.INI\TestExcel\Engines\Excel]
"Driver"="{Microsoft Excel Driver (*.xls)}"
"ImplicitCommitSync"=""
"Threads"=dword: 00000003 
"UserCommitSync"="Yes"
"FirstRowHasNames"=hex: 01