ADO cannot connect to Database

[Mike2502]

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?

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

 

[juddaaaa]

You've set the file path to the workbook you're currently in

DBPath = ThisWorkbook.FullName

where it should be

DBPath = "Employee List.xlsx"

Here's an approach I always use

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

 

[Mike2502]

You've set the file path to the workbook you're currently in

DBPath = ThisWorkbook.FullName

where it should be

DBPath = "Employee List.xlsx"

Here's an approach I always use

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****

Set mrs = .Execute

 

[juddaaaa]

The worksheet is called Staff****

What does this mean?

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

 

[Mike2502]

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

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

 

[juddaaaa]

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

 

[Mike2502]

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

Yeah

 

[juddaaaa]

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

 

[Mike2502]

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?

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),)"

 

[juddaaaa]

I think you may need some single quotes around the reference to the external workbook and worksheet like below

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