Closing Data connections using VBA

[xigrix]

Hi

I've written spreadsheet which reads and writes data from an access database.

I think I've got some poor code though - when I click on the data Connections in the Data toolbar it takes an age to load and has thousands of entries - I think this is slowing down the whole workbook (opening and closing times are very lengthy)

Does anyone know a method by which I can close these en masse using VBA?

I'm guessing there's a for each collection I can use but I'm not sure which one

Thanks

xigrix

 

[JackDanIce]

Can you post your code please?

 

[xigrix]

Sub myPass(sql)

'update the sql
If ThisWorkbook.Worksheets("Params2").Cells(2, 9) = True Then
ThisWorkbook.Worksheets("Params2").Range("A3:D1048576").Clear
End If
myRow = [updateLog]
myStart = Now
ThisWorkbook.Worksheets("params2").Cells(myRow, 1) = sql


Application.StatusBar = sql

Dim objCommand As ADODB.Command
Dim rsData As ADODB.Recordset
Dim lRecordsAffected As Long
Dim lKey As Long
Dim sConnect As String
myLocation = ThisWorkbook.Worksheets("params2").Cells(1, 9)

On Error GoTo ErrorHandler

' Create the connection string.
sConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & myLocation & ";" & _
"Mode=Share Exclusive"

' Create the Command object we'll use for all three queries.
Set objCommand = New ADODB.Command
objCommand.ActiveConnection = sConnect


objCommand.CommandText = sql

'Execute the SQL statement.
objCommand.Execute RecordsAffected:=lRecordsAffected, _
Options:=adCmdText Or adExecuteNoRecords

ThisWorkbook.Worksheets("params2").Cells(myRow, 2) = lRecordsAffected
ThisWorkbook.Worksheets("params2").Cells(myRow, 3) = myStart
ThisWorkbook.Worksheets("params2").Cells(myRow, 4) = DateDiff("s", myStart, Now)

Application.StatusBar = False

ErrorExit:

' Destroy our ADO objects.


Set objCommand = Nothing
Set rsData = Nothing
ThisWorkbook.Worksheets("Params").Activate
Exit Sub

ErrorHandler:
If Err.Number <> -2147467259 Then

' MsgBox Err.Description, vbCritical
Else
Set objCommand = Nothing
Set rsData = Nothing
ThisWorkbook.Worksheets("Params").Activate
Exit Sub
End If
Resume ErrorExit

End Sub