Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Rhinorhino on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Run-time error '3343': unrecognized database format. 1

Status
Not open for further replies.

PWD

Technical User
Joined
Jul 12, 2002
Messages
823
Location
GB
Basically, I'm trying to find a (good) way of getting data from Access 2007 (3 tables, a total of 209 Columns) into Excel 2010 & have started by doing it from Excel. In the course of doing some other stuff I had used some code - that I got from somewhere - to create an Access file.

Code:
Sub NewDatabase()
    Dim wspDefault As Workspace, dbs As Database
    Dim tdf As TableDef, fld1 As Field, fld2 As Field
    Dim idx As Index, fldIndex As Field

    Set wspDefault = DBEngine.Workspaces(0)
    ' Create new, encrypted database.
    
    Set dbs = wspDefault.CreateDatabase("Newdb.mdb", _
        dbLangGeneral, dbEncrypt)
    ' Create new table with two fields.
    Set tdf = dbs.CreateTableDef("Contacts")
    Set fld1 = tdf.CreateField("ContactID", dbLong)
    fld1.Attributes = fld1.Attributes + dbAutoIncrField
    Set fld2 = tdf.CreateField("ContactName", dbText, 50)
    ' Append fields.
    tdf.Fields.Append fld1
    tdf.Fields.Append fld2
    ' Create primary key index.
    Set idx = tdf.CreateIndex("PrimaryKey")
    Set fldIndex = idx.CreateField("ContactID", dbLong)
    ' Append index fields.
    idx.Fields.Append fldIndex
    ' Set Primary property.
    idx.Primary = True
    ' Append index.
    tdf.Indexes.Append idx
    ' Append TableDef object.
    dbs.TableDefs.Append tdf
    dbs.TableDefs.Refresh
    Set dbs = Nothing
End Sub

and it created a file:-

Code:
"C:\Documents and Settings\des.lavender\My Documents\Newdb.mdb"

If I use that file to get data back to Excel using:-
Code:
Sub MYThursday()
  Dim db As DAO.Database
  Dim rs As DAO.Recordset
  Dim myRange As Range

Set ws = ActiveSheet
Set myRange = ws.Range("A2")

      
    Set db = OpenDatabase("C:\Documents and Settings\des.lavender\My Documents\Newdb.mdb")
    ' open the database
    
        Set rs = db.OpenRecordset("Contacts", dbOpenTable)
    ' get all records in a table

'Check for results
If (rs.EOF And rs.BOF) Then
    Debug.Print "There is no data"
Else
    'Write to value Excel Sheet
    Call myRange.CopyFromRecordset(rs)
End If
'Clean up objects
If Not rs Is Nothing Then Set rs = Nothing

End Sub

it works just fine. But if I change the database to the one I created in Access 2007,
Code:
Set db = OpenDatabase("C:\Documents and Settings\des.lavender\Access\LBLTest1.accdb")
I get the above error.

I found a post that recommended installing Microsoft Office 12.0 Object Library. That wasn't in the list under Tools|References so I downloaded it from Microsoft.com but it fails to install.

I was going to get the data back one Table at a time & just exclude the Primary Key field ("Serial Number") from passes 2 & 3. I want to give my users the ability to download this data from Excel but I'm completely stuck. Any suggestions will be gratefully received.

Many thanks,

Des.
 
Oh, and I can't "Save As" into a different Access file extension. I only have the .accdb option :(
 


hi,

This should be pretty simple and not require ANY VBA code.

I can't say exactly what the Excel 2010 step are, but it sould be something like...

Data > External Data > Other Sources

and this should get you an MS Query - Choose data source dialog.

Choose MS Access Database*, drill down to the database, open and select your tables to join the QBE grid.

If you need to have this coded, then you can use the Macro Recorder to generate code. I would just caution that if you code ADDING a querytable to your sheet, then you will have multiple ListObjects in your sheet. When I code, I simply use the CommandText, Connection and refresh properties to refresh my query.

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
A good idea Skip - as usual. I found this so I could do it for them from Access.

Code:
Sub Stuff()

For T = 2 To 4
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "Sheet" & T, _
"C:\Documents and Settings\des.lavender\Desktop\Book1.xlsm", True
Next T
End Sub

It's mighty fast!! :) I just have to add the Columns (excluding "A") from Sheet3 & Sheet4 to Sheet2. Not too bad really.

Many thanks,

Des.
 
This was what the macro recorder helped me achieve:-
Code:
For T = 2 To 4

Sheets("Sheet" & T).Select
    With ActiveSheet.ListObjects.Add(SourceType:=0, Source:=Array( _
        "OLEDB;Provider=Microsoft.ACE.OLEDB.12.0;Password="""";User ID=Admin;Data Source=C:\Documents and Settings\des.lavender\Access\LBLTest1.a" _
        , _
        "ccdb;Mode=Share Deny Write;Extended Properties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Pas" _
        , _
        "sword="""";Jet OLEDB:Engine Type=6;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Tra" _
        , _
        "nsactions=1;Jet OLEDB:New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB" _
        , _
        ":Don't Copy Locale on Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False;Jet OLEDB:Support Complex" _
        , " Data=False"), Destination:=Sheets("Sheet" & T).Range("$A$1")).QueryTable
        .CommandType = xlCmdTable
        .CommandText = Array("Sheet" & T)
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .SourceDataFile = _
        "C:\Documents and Settings\des.lavender\Access\LBLTest1.accdb"
'        .ListObject.DisplayName = "Table_LBLTest1.accdb"
        .Refresh BackgroundQuery:=False
    End With
    
    On Error Resume Next
    x = ActiveSheet.AutoFilter.Range.Areas.Count
    If Err.Number = 0 Then
        ActiveSheet.Range("A1").AutoFilter
    End If
    On Error Resume Next

    Next T
I couldn't make any sense of the
Code:
.ListObject.DisplayName = "Table_LBLTest1.accdb"
so I just commented it out.

So far so good,

Des.
 



You seem to be querying the same table (entire table) on all 3 sheets.

What is your intent?

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top