ADO cannot connect to Database

Mike2502

Board Regular
Joined
Jan 19, 2020
Messages
143
Office Version
  1. 2010
Hi

I'm trying to connect to an external file called 'Employee List' and the worksheet is called 'All Staff Members' but it doesn't seem to connect?

VBA Code:
Option Explicit

'Add reference for Microsoft Activex Data Objects Library

Sub sbADO()
Dim sSQLQry As String
Dim sSQLSting As String
Dim ReturnArray

Dim Conn As New ADODB.Connection
Dim mrs As New ADODB.Recordset

Dim DBPath As String, sconnect As String

DBPath = ThisWorkbook.FullName

'You can provide the full path of your external file as shown below
'DBPath = "C:\Users\me\DataNow\Home\Desktop\documents\projects\database\copy"

sconnect = "Provider=MSDASQL.1;DSN=Excel Files;DBQ=" & DBPath & ";HDR=Yes';"

Conn.Open sconnect
 sSQLSting = "Select [ID], [Leave Reason], [Ops Director], [Forename], [Surname], [Date of birth], [Start Date],[Job Title] from [All Staff Members$] WHERE [ID] in ('" & _
Join(Application.Transpose(Range("A2:A50").Value), "','") & "')"
 
    mrs.Open sSQLSting, Conn
        '=>Load the Data into an array
        'ReturnArray = mrs.GetRows
                ''OR''
        '=>Paste the data into a sheet
        ActiveSheet.Range("A2").CopyFromRecordset mrs
    'Close Recordset
    mrs.Close

'Close Connection
Conn.Close
 

Excel Facts

Repeat Last Command
Pressing F4 adds dollar signs when editing a formula. When not editing, F4 repeats last command.
You've set the file path to the workbook you're currently in
VBA Code:
DBPath = ThisWorkbook.FullName

where it should be
VBA Code:
DBPath = "Employee List.xlsx"

Here's an approach I always use
VBA Code:
Option Explicit

Sub sbADO()
  Dim Conn As Object, Comm As Object, mrs As Object
 
  ' Removes the need to reference external library
  Set Conn = CreateObject("ADODB.Connection")
  Set Comm = CreateObject("ADODB.Command")
 
  Dim DBPath As String
  DBPath = "Employee List.xlsx"
 
  With Conn
    .Provider = "Microsoft.ACE.OLEDB.12.0"
    .Properties("Extended Properties") = "Excel 12.0 Xml; HDR=Yes"
    .Properties("Data Source") = DBPath
    .Open
  End With
  
  With Comm
    .ActiveConnection = Conn
    .CommandText = "SELECT [ID], [Leave Reason], [Ops Director], [Forename], [Surname], [Date of birth], [Start Date],[Job Title] FROM [All Staff Members$] WHERE [ID] IN ('" & _
                   Join(Application.Transpose(Range("A2:A50").Value), "','") & "')"
    Set mrs = .Execute
  End With
 
  If Not (mrs.BOF And mrs.EOF) Then
    ActiveSheet.Range("A2").CopyFromRecordset mrs
  End If
 
  Set mrs = Nothing
  Set Conn = Nothing
End Sub
 
Upvote 0
You've set the file path to the workbook you're currently in
VBA Code:
DBPath = ThisWorkbook.FullName

where it should be
VBA Code:
DBPath = "Employee List.xlsx"

Here's an approach I always use
VBA Code:
Option Explicit

Sub sbADO()
  Dim Conn As Object, Comm As Object, mrs As Object

  ' Removes the need to reference external library
  Set Conn = CreateObject("ADODB.Connection")
  Set Comm = CreateObject("ADODB.Command")

  Dim DBPath As String
  DBPath = "Employee List.xlsx"

  With Conn
    .Provider = "Microsoft.ACE.OLEDB.12.0"
    .Properties("Extended Properties") = "Excel 12.0 Xml; HDR=Yes"
    .Properties("Data Source") = DBPath
    .Open
  End With

  With Comm
    .ActiveConnection = Conn
    .CommandText = "SELECT [ID], [Leave Reason], [Ops Director], [Forename], [Surname], [Date of birth], [Start Date],[Job Title] FROM [All Staff Members$] WHERE [ID] IN ('" & _
                   Join(Application.Transpose(Range("A2:A50").Value), "','") & "')"
    Set mrs = .Execute
  End With

  If Not (mrs.BOF And mrs.EOF) Then
    ActiveSheet.Range("A2").CopyFromRecordset mrs
  End If

  Set mrs = Nothing
  Set Conn = Nothing
End Sub
Cheers much more simplfied code however I get an error below on line
The worksheet is called Staff****

VBA Code:
Set mrs = .Execute
 

Attachments

  • 1581867393010.png
    1581867393010.png
    16.3 KB · Views: 9
Upvote 0
What does this mean?

You need to enter the exact name of the worksheet you are trying to connect to
Hi Juda,

Sorted that issue mate, but see below my database is in the same directory called 'Copy' and worksheet name is 'Staff'

Comes up with a runtime error 1004

VBA Code:
Range("I2").Formula = "=IF(VLOOKUP($A2,[Copy.xlsx]Staff!$1:$1048576,24,FALSE)="""","""",VLOOKUP($A2,DataSheet!A$1:Y$700,24,FALSE))"
Range("J2").Formula = "=IF($G2<=$I2,$G2,$I2)"
Range("K2").Formula = "=TEXT(IF(VLOOKUP($A2,[Copy.xlsx]Staff!$1:$1048576,25,FALSE)="""",""Currently Working"",VLOOKUP($A2,DataSheet!A$1:AB$700,25,FALSE)),""dd mmmm yyyy"")"
Range("M2").Formula = "=CONCATENATE($D2,"" "",$E2)"
Range("O2").Formula = "=TEXT(CONCATENATE(""Reference"", "" For "", $M2),)"

Range("I2:I50").FillDown
Range("J2:J50").FillDown
Range("K2:K50").FillDown
Range("M2:M50").FillDown
Range("O2:O50").FillDown
 
Upvote 0
I'm trying to connect to an external file called 'Employee List' and the worksheet is called 'All Staff Members' but it doesn't seem to connect?
I'm confused.

We've gone from a file called Employee List with a worksheet called All Staff Members to a file called Copy with a worksheet called Staff
 
Upvote 0
VBA Code:
Option Explicit

Sub sbADO()
  Dim Conn As Object, Comm As Object, mrs As Object
 
  ' Removes the need to reference external library
  Set Conn = CreateObject("ADODB.Connection")
  Set Comm = CreateObject("ADODB.Command")
 
  Dim DBPath As String
  DBPath = ThisWorkbook.Path & "\Copy.xlsx"
 
  With Conn
    .Provider = "Microsoft.ACE.OLEDB.12.0"
    .Properties("Extended Properties") = "Excel 12.0 Xml; HDR=Yes"
    .Properties("Data Source") = DBPath
    .Open
  End With
  
  With Comm
    .ActiveConnection = Conn
    .CommandText = "SELECT [ID], [Leave Reason], [Ops Director], [Forename], [Surname], [Date of birth], [Start Date],[Job Title] FROM [Staff$] WHERE [ID] IN ('" & _
                   Join(Application.Transpose(Range("A2:A50").Value), "','") & "')"
    Set mrs = .Execute
  End With
 
  If Not (mrs.BOF And mrs.EOF) Then
    ActiveSheet.Range("A2").CopyFromRecordset mrs
  End If
 
  Set mrs = Nothing
  Set Conn = Nothing
End Sub
 
Upvote 0
VBA Code:
Option Explicit

Sub sbADO()
  Dim Conn As Object, Comm As Object, mrs As Object

  ' Removes the need to reference external library
  Set Conn = CreateObject("ADODB.Connection")
  Set Comm = CreateObject("ADODB.Command")

  Dim DBPath As String
  DBPath = ThisWorkbook.Path & "\Copy.xlsx"

  With Conn
    .Provider = "Microsoft.ACE.OLEDB.12.0"
    .Properties("Extended Properties") = "Excel 12.0 Xml; HDR=Yes"
    .Properties("Data Source") = DBPath
    .Open
  End With
 
  With Comm
    .ActiveConnection = Conn
    .CommandText = "SELECT [ID], [Leave Reason], [Ops Director], [Forename], [Surname], [Date of birth], [Start Date],[Job Title] FROM [Staff$] WHERE [ID] IN ('" & _
                   Join(Application.Transpose(Range("A2:A50").Value), "','") & "')"
    Set mrs = .Execute
  End With

  If Not (mrs.BOF And mrs.EOF) Then
    ActiveSheet.Range("A2").CopyFromRecordset mrs
  End If

  Set mrs = Nothing
  Set Conn = Nothing
End Sub
Brill mate, got that working but I have columns which are vlookups through VBA see below the name of the spreadsheet doesn't seem to get found?

VBA Code:
Range("I2").Formula = "=IF(VLOOKUP($A2,[Copy.xlsx]Staff!$1:$1048576,24,FALSE)="""","""",VLOOKUP($A2,DataSheet!A$1:Y$700,24,FALSE))"
Range("J2").Formula = "=IF($G2<=$I2,$G2,$I2)"
Range("K2").Formula = "=TEXT(IF(VLOOKUP($A2,[Copy.xlsx]Staff!$1:$1048576,25,FALSE)="""",""Currently Working"",VLOOKUP($A2,DataSheet!A$1:AB$700,25,FALSE)),""dd mmmm yyyy"")"
Range("M2").Formula = "=CONCATENATE($D2,"" "",$E2)"
Range("O2").Formula = "=TEXT(CONCATENATE(""Reference"", "" For "", $M2),)"
 
Upvote 0
I think you may need some single quotes around the reference to the external workbook and worksheet like below

Rich (BB code):
Range("I2").Formula = "=IF(VLOOKUP($A2,'[Copy.xlsx]Staff'!$1:$1048576,24,FALSE)="""","""",VLOOKUP($A2,DataSheet!A$1:Y$700,24,FALSE))"
 
Upvote 0

Forum statistics

Threads
1,223,896
Messages
6,175,263
Members
452,627
Latest member
KitkatToby

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top