Извлечение файлов при запуске устанавливает вместо конца

Попробуйте это

Sub GetData()

Dim cnDump As ADODB.Connection
Set cnDump = New ADODB.Connection

' Provide the connection string.
Dim strConn As String

'Use the SQL Server OLE DB Provider.
strConn = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=True;Initial Catalog=XXXX;Data Source=XXXX\XXXX;Use Procedure for Prepare=1;Auto Translate=True;Packet Size=4096;Workstation ID=XXXX;Use Encryption for Data=False;Tag with column collation when possible=False;"

'Now open the connection.
cnDump.Open strConn