Excel SQL Statements, Appending Excel Named Range to Access ADO

[becca51178]

Repost from earlier this week

http://www.mrexcel.com/forum/showth...nts-Appending-Excel-Named-Range-to-Access-ADO

I have tried everything and I cannot get this code to work. Also, I am working in Excel and Access 2010

Sub paste_access()
Dim cnn As ADODB.Connection
Dim dbCommand As ADODB.Command
Dim rs As ADODB.Recordset
Dim dbFileName As String
Dim dbtableName As String
Dim Rng As Range
Dim strSQL As String
   
dbFileName = "C:\Users\rwelch\Desktop\Access Databases\WasteData.accdb"
dbtableName = "LookupOrders"
     
Set cnn = New ADODB.Connection
        With cnn
        .Provider = "Microsoft.ACE.OLEDB.12.0;"
        .ConnectionString = "Data Source=" & dbFileName & ";"
        .Open
        End With
     
     
Set dbCommand = New ADODB.Command
   dbCommand.CommandText = "INSERT INTO LookupOrders SELECT * FROM [Open_Order$] IN '" _
    & ThisWorkbook.FullName
      Set dbCommand.ActiveConnection = cnn
                dbCommand.Execute
                    Set dbCommand = Nothing
                        Set dbConnection = Nothing
     
                            End Sub

End Sub

I have been struggling with this for a few days now.

I have an access database I use once a week. I have a list of orders in an excel spreadsheet. I want to be able to delete the orders in the access db from the previous week and append the new week's data.

Basically, a code that
1st) deletes records in an access table
2nd) copies from a named range in excel
3rd) appends the named range from Excel back to the same table in Access

I was able to put together a code that will delete the values with no issues, but the copying from excel and inserting into access just won't work!

Help please!


Here is the delete code that works fine:

Sub DeleteAccessTable()
Dim cnn As ADODB.Connection
Dim dbCommand As ADODB.Command
Dim rs As ADODB.Recordset
Dim dbFileName As String
Dim dbtableName As String
Dim Rng As Range
Dim strSQL As String
dbFileName = "C:\Users\rwelch\Desktop\Access Databases\WasteData.accdb"
dbtableName = "LookupOrders"
 
Set cnn = New ADODB.Connection
With cnn
        .Provider = "Microsoft.ACE.OLEDB.12.0;"
        .ConnectionString = "Data Source=" & dbFileName & ";"
        .Open
End With
Set dbCommand = New ADODB.Command
        dbCommand.CommandText = "DELETE * from LookupOrders"
            Set dbCommand.ActiveConnection = cnn
                dbCommand.Execute
                    Set dbCommand = Nothing
                        Set dbConnection = Nothing
                            Set cnn = Nothing
                                 End Sub

 

[xenou]

There have been problems running ADO queries on open workbooks, which precludes running any ado query in "this workbook" which is unavoidably always an open one. I don't know if this is something that is fixed in recent years or not, but I would advise running your code from Access, not from Excel, with the workbook being closed. However, another simple remedy is to copy the data to another workbook (temp file) and run the import on the closed file. In that case, I would forget about the named range and just copy the data to A1 in the temp file, so you can address the data simply as "Sheet1". Let me know if that works for you. I've had one weird and unexplainable problem with importing from Excel in Access 2007 with one particular file/table combination using an xlsx file, which I consider a bug, so a csv or xml file is possibly another try for you with your temp file. See if that works - otherwise, post back with your latest code revisions.

 

[becca51178]

Ok, I will drop the named range and see if that will work out. Thanks!

 

[becca51178]

And I have lost years off my life trying to figure this out, but this is what I came up with.
It's way too difficult for me to try and figure out a way to reference a named range so I was stuck using a loop.

Here is the solution that I am using to delete records from a table in access and paste new records from a range in excel

Delete Records in Access Table

Sub DeleteAccessTable()
Dim cnn As ADODB.Connection
Dim dbCommand As ADODB.Command
Dim rs As ADODB.Recordset
Dim dbfilename As String
Dim dbtableName As String
Dim rng As Range
Dim strSQL As String
dbfilename = "C:\Users\rwelch\Desktop\Access Databases\WasteData.accdb"
dbtableName = "LookupOrders"
 
Set cnn = New ADODB.Connection
With cnn
        .Provider = "Microsoft.ACE.OLEDB.12.0;"
        .ConnectionString = "Data Source=" & dbfilename & ";"
        .Open
End With
Set dbCommand = New ADODB.Command
        dbCommand.CommandText = "DELETE * from LookupOrders"
            Set dbCommand.ActiveConnection = cnn
                dbCommand.Execute
                    Set dbCommand = Nothing
                        Set dbConnection = Nothing
                            Set cnn = Nothing
 Call ADOFromExcelToAccess
  
End Sub

Paste New Records

Sub ADOFromExcelToAccess()
Dim cnn As ADODB.Connection, rs As ADODB.Recordset, r As Long
Dim dbfilename As String
Dim ws As Worksheet

On Error GoTo errhandler

dbfilename = "C:\Users\rwelch\Desktop\Access Databases\WasteData.accdb"
Set ws = ActiveWorkbook.Sheets("YL Orders")
    Set cnn = New ADODB.Connection
    cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0; " & _
        "Data Source=" & dbfilename & ";"
Set rs = New ADODB.Recordset
    rs.Open "LookupOrders", cnn, adOpenKeyset, adLockOptimistic, adCmdTable
    
    r = 2
    Do While Len(ws.Range("A" & r).Formula) > 0
    With rs
        .AddNew ' create a new record
        .Fields("ProductionOrder") = ws.Range("J" & r).Value
        .Update ' stores the new record
        End With
        r = r + 1 ' next row
    Loop
    rs.Close
    Set rs = Nothing
    cnn.Close
    Set cnn = Nothing
    
errhandler:
Exit Sub
End Sub

This is where I found the codes.

http://www.erlandsendata.no/english/index.php?d=envbadacexportado

 

[xenou]

It's way too difficult for me to try and figure out a way to reference a named range so I was stuck using a loop.

No problem with that, as long as the amount of data isn't extremely large you'll be fine.

Here's an alternative I cooked up for you where you run the query from access. In think I remember a thread here at the board which was similar to your original attempt - I'll see if I can find it for you. Meantime, you can try this if you care to:

[COLOR="Navy"]Sub[/COLOR] ADOFromExcelToAccess()
[COLOR="Navy"]Dim[/COLOR] rng [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] dbFileName [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Dim[/COLOR] xlTempFile [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Dim[/COLOR] wbTemp [COLOR="Navy"]As[/COLOR] Workbook


    [COLOR="Navy"]On[/COLOR] [COLOR="Navy"]Error[/COLOR] [COLOR="Navy"]GoTo[/COLOR] ErrHandler
    
    [COLOR="SeaGreen"]'//File Paths[/COLOR]
    dbFileName = "C:\myTemp\db1.accdb"
    xlTempFile = "C:\Users\Kermit\Desktop\"
    xlTempFile = xlTempFile & Replace(CreateObject("Scripting.FileSystemObject").GetTempName, ".tmp", ".xlsx")
    
    [COLOR="SeaGreen"]'//Copy data to temp file[/COLOR]
    [COLOR="Navy"]Set[/COLOR] rng = ThisWorkbook.Sheets("Sheet1").Range("_Test")
    [COLOR="Navy"]Set[/COLOR] wbTemp = Workbooks.Add
    rng.Copy
    wbTemp.Sheets(1).Cells(1, 1).PasteSpecial xlPasteValuesAndNumberFormats
    wbTemp.SaveAs xlTempFile, FileFormat:=51 [COLOR="SeaGreen"]'xlsx[/COLOR]
    wbTemp.Close False
            
    [COLOR="SeaGreen"]'//Run Access query[/COLOR]
    [COLOR="Navy"]Call[/COLOR] RunAccessAppendQuery(xlTempFile)


Exit_Sub:
[COLOR="Navy"]On[/COLOR] [COLOR="Navy"]Error[/COLOR] [COLOR="Navy"]Resume[/COLOR] [COLOR="Navy"]Next[/COLOR]
Kill xlTempFile
[COLOR="Navy"]Exit[/COLOR] [COLOR="Navy"]Sub[/COLOR]

ErrHandler:
[COLOR="Navy"]Debug[/COLOR].[COLOR="Navy"]Print[/COLOR] Err.Description
[COLOR="Navy"]Resume[/COLOR] Exit_Sub

[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

[COLOR="Navy"]Function[/COLOR] RunAccessAppendQuery(ByVal sFileName [COLOR="Navy"]As[/COLOR] String) [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Boolean[/COLOR]
[COLOR="Navy"]Dim[/COLOR] appAccess [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Object[/COLOR]


[COLOR="Navy"]On[/COLOR] [COLOR="Navy"]Error[/COLOR] [COLOR="Navy"]GoTo[/COLOR] ErrHandler:

    [COLOR="Navy"]Set[/COLOR] appAccess = CreateObject("Access.Application")
    [COLOR="Navy"]With[/COLOR] appAccess
        .OpenCurrentDatabase "C:\myTemp\db1.accdb"
        .DoCmd.SetWarnings False
        .DoCmd.TransferSpreadsheet acImport, , "Table1", sFileName, True
    [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
    RunAccessAppendQuery = True [COLOR="SeaGreen"]'//Successful Exit Flag[/COLOR]

My_Exit:
appAccess.Quit
[COLOR="Navy"]Exit[/COLOR] [COLOR="Navy"]Function[/COLOR]

ErrHandler:
MsgBox "Error running Access Append Procedure: " & vbNewLine & Err.Description
[COLOR="Navy"]Resume[/COLOR] My_Exit

[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Function[/COLOR]