VBA conversion

[jtodd]

Hi
I have an old excell file that I am trying to update from 97 to 2016.
All works well apart from this bit of code

Set Db = Workspaces(0).OpenDatabase(Path, ReadOnly:=True)

The file refers to an access 97 database wich I have now conferted to access 2016 .

When I run the code i get a debug error with this line of code highligted , do i need a different code for access 2016?

Any help

 

[Norie]

What's the error?

Also, what is the code that this line is from meant to be doing?

 

[jtodd]

This is the full code

Sub GetRouteQueryDef()
       
         Dim Db As Database
         Dim Qd As QueryDef
         Dim Rs As Recordset
         Dim Ws As Object
         Dim i As Integer
      Dim Path As String
      
      Path = "S:\Jim Todd\Testing_Recovered\RDC_Excel_testing\PlanningTracker\Tracker.accdb"
       Set Ws = Sheets("RouteCodes")

       Ws.Activate
       Range("A1").Activate
       Selection.CurrentRegion.Select
       Selection.ClearContents
       Range("A1").Select

       Set Db = Workspaces(0).OpenDatabase(Path, ReadOnly:=True)
       Set Qd = Db.QueryDefs("Newark_RDC_Route_NBDR_A")
       Set Rs = Qd.OpenRecordset()
       For i = 0 To Rs.Fields.Count - 1
           Ws.Cells(1, i + 1).Value = Rs.Fields(i).Name
       Next
      Ws.Range(Ws.Cells(1, 1), Ws.Cells(1, Rs.Fields.Count)).Font.Bold _
          = True

       Ws.Range("a2").CopyFromRecordset Rs
       Sheets("RouteCodes").Select
       Range("A1").Select
       Selection.CurrentRegion.Select
       Selection.Columns.AutoFit
       Range("A1").Select

       Qd.Close
       Rs.Close
       Db.Close


   End Sub

It gets data from the database .

Error message
Run Time error '429'
ActiveX componant cant create componant

 

[Norie]

Are you copying the data from the Access query/table Newark_RDC_Route_NBDR_A into Excel?

If you are try this.

Sub GetRouteQueryDef()
Dim ws As Worksheet
Dim conn As Object
Dim rs As Object
Dim strPath As String
Dim I As Long

    strPath = "S:\Jim Todd\Testing_Recovered\RDC_Excel_testing\PlanningTracker\Tracker.accdb"

    Set ws = Sheets("RouteCodes")

    ws.Range("A1").CurrentRegion.Select

    Set conn = CreateObject("ADODB.Connection")
    With conn
       .Provider = "Microsoft.ACE.OLEDB.12.0"
       .ConnectionString = "Data Source=" & strPath & ";"
    End With
    
    Set rs = CreateObject("ADODB.Recordset")
    
    rs.Open "Newark_RDC_Route_NBDR_A", conn ' SELECT * FROM Newark_RDC_Rout_NBDR_A
    
    With ws
    
        For I = 0 To rs.Fields.Count - 1
            .Cells(1, I + 1).Value = rs.Fields(I).Name
        Next I
    
        .Cells(1, 1).Resize(1, rs.Fields.Count).Font.Bold = True

        .Range("a2").CopyFromRecordset rs
        
        .UsedRange.EntireColumn.AutoFit
        
    End With
    
    conn.Close
    
    Set conn = Nothing
    
    rs.Close
    
    Set rs = Nothing

End Sub

 

[jtodd]

Hi i get an error message

Runtime Error 1004
Select Method of Range class failed

 

[Norie]

Change this,

ws.Range("A1").CurrentRegion.Select

to this.

ws.Range("A1").CurrentRegion.ClearContents

 

[jtodd]

Sorry but now get error message

Runtime Error 3709
the conection cannot be used to perform this operation . It is either
closed or invalid in this context .

 

[Norie]

You still haven't mentioned what this code is meant to do so what I posted was kind of a guess.

One last shot.

Sub GetRouteQueryDef()
Dim ws As Worksheet
Dim conn As Object
Dim rs As Object
Dim strPath As String
Dim I As Long

    strPath = "S:\Jim Todd\Testing_Recovered\RDC_Excel_testing\PlanningTracker\Tracker.accdb"

    Set ws = Sheets("RouteCodes")

    ws.Range("A1").CurrentRegion.ClearContents

    Set conn = CreateObject("ADODB.Connection")

    With conn
       .Provider = "Microsoft.ACE.OLEDB.12.0"
       .ConnectionString = "Data Source=" & strPath & ";"
    End With
    
    conn.Open

    Set rs = CreateObject("ADODB.Recordset")
    
    rs.Open "Newark_RDC_Route_NBDR_A", conn ' SELECT * FROM Newark_RDC_Rout_NBDR_A", conn
    
    With ws
    
        For I = 0 To rs.Fields.Count - 1
            .Cells(1, I + 1).Value = rs.Fields(I).Name
        Next I
    
        .Cells(1, 1).Resize(1, rs.Fields.Count).Font.Bold = True

        .Range("a2").CopyFromRecordset rs
        
        .UsedRange.EntireColumn.AutoFit
        
    End With
    
    conn.Close
    
    Set conn = Nothing
    
    rs.Close
    
    Set rs = Nothing

End Sub