Still Having Trouble with Excel to Access

[Vladamir]

I was lucky to have a DBA guy come over and look at this with me, but try as we might we still could not get this working like we want.

We have an Excel spreadsheet in which the users fill in some data. When the user clicks one of the buttons, off it goes to create a drawing in AutoCAD...that part is working perfectly.

I recently was tasked to add some code which will:

1. Look in an Access database, determine the record with the highest value in a field (DwgNo) in Table1.
2. Add 1 to this value and insert this value in cell "F10" in the spreadsheet.
3. Add a new record to the Access database using the value that was inserted in cell F10 as the value the DwgNo field
as well as insert additional data into the other respective fields in the database.

The process will then continue on to the drawing creation but as I mentioned above, that part works fine. Here are the two modules the DBA guy helped me with. We are not locked into this so if anyone has a viable suggestion on a better way to do it, then please feel free to comment on that.

Module 4 (This is inserts the new record into the Access database)

Sub FromExcelToAccess()

With ActiveSheet.QueryTables.Add(Connection:=Array(Array( _
        "ODBC;DSN=MS Access Database;DBQ=C:\MyFiles\db1.mdb;DefaultDir=C:\MyFiles;DriverId=25;FIL=MS Access;MaxBufferSi" _
        ), Array("ze=2048;PageTimeout=5;")), Destination:=Range("F10"))
        .CommandText = Array( _
        "INSERT INTO Table1 ( [Date], [UserName], DwgNo, Description, Material, QuoteNum, Status ) Select '06/21/2012', 'FLG-p', " & Range("F10") & ", 'Some Text 42 x 77', 'Alum', '103112', 'Approved'" _
        )
        .Name = "Query from MS Access Database"
        .FieldNames = False
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlOverwriteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = False
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .Refresh BackgroundQuery:=True
            
    End With
    
End Sub

Module 5 (This gets the largest value in the field DwgNo from the database)

Sub Start ()
ActiveSheet.Unprotect "my_passwd"

    With ActiveSheet.QueryTables.Add(Connection:=Array(Array( _
        "ODBC;DSN=MS Access Database;DBQ=C:\MyFiles\db1.mdb;DefaultDir=C:\MyFiles;DriverId=25;FIL=MS Access;MaxBufferSi" _
        ), Array("ze=2048;PageTimeout=5;")), Destination:=Range("F10"))
        .CommandText = Array( _
        "SELECT MAX([DwgNo]) +1 FROM `C:\MyFiles\db1`.Table1" _
        )
        .Name = "Query from MS Access Database"
        .FieldNames = False
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlOverwriteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = False
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .Refresh BackgroundQuery:=True
    End With
    
    FromExcelToAccess
    
    ActiveSheet.Protect "my_passwd"
    
End Sub

The button I click on runs Module #5 first, then Module #4 is called from within. When I run this, by clicking on the button, it opens the Access database, gets the largest number, adds 1, and properly inserts this into cell F10. But then it crashes in Module #4 with a Run-time error '1004': General ODBC Error. I click on the Debug button and it highlights the .Refresh BackgroundQuery:=True line in Module #4.

Any suggestions or advice would be appreciated.

[gjlindn]

Hi Vladamir. In your module FromExcelToAccess you're attempting to run an insert query by refreshing an excel query table...that can't be done. You need to execute an insert statement. I don't know the ODBC method all that well; I use ADO. Here's what I'd do:

Public oCon As ADODB.Connection

Sub FromExcelToAccess()
     OpenDB
     oCon.Execute "INSERT INTO Table1 ( [Date], [UserName], DwgNo, Description, Material, QuoteNum, Status ) Select '06/21/2012', 'FLG-p', " & _
          Range("F10") & ", 'Some Text 42 x 77', 'Alum', '103112', 'Approved'"
    oCon.Close
End Sub

Sub OpenDB()
    Set oCon = CreateObject("ADODB.Connection")
    oCon.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & "C:\MyFiles\db1.mdb;"
End Sub