Run Time Error 3001

[mrmmickle1]

I am trying to do several things in this procedure:

1. Delete an existing table.
2. Then create a new table.
3. Then write records to the table

I have been successful with the first two items however, I am getting a Run Time Error 3001 Application Defined or Object Defined Error on the red line when I try to open the table to input the records. Any help resolving this problem would be great.

[COLOR=#0000ff]Public Sub[/COLOR] AccessTableUpdate()

    [COLOR=#0000ff]Dim[/COLOR] CurrentAccessDB   [COLOR=#0000ff]As String[/COLOR]
    [COLOR=#0000ff]Dim [/COLOR]adoRecSet        [COLOR=#0000ff] As Object[/COLOR][COLOR=#008000] 'As New ADODB.Recordset[/COLOR]
    [COLOR=#0000ff]Dim[/COLOR] connDB          [COLOR=#0000ff]  As Object [/COLOR]'[COLOR=#008000]As New ADODB.Connection[/COLOR]
   [COLOR=#0000ff] Dim[/COLOR] rng               [COLOR=#0000ff]As[/COLOR] Range
    [COLOR=#0000ff]Dim[/COLOR] i                 [COLOR=#0000ff]As Long[/COLOR]
   [COLOR=#0000ff] Dim[/COLOR] lFieldCount       [COLOR=#0000ff]As Long[/COLOR]
    [COLOR=#0000ff]Dim[/COLOR] strSql            [COLOR=#0000ff]As String[/COLOR]

    CurrentAccessDB = "C:\Users\mmickle\Desktop\PCLS_Master_Review_Database.mdb"
   [COLOR=#0000ff] Set[/COLOR] connDB = CreateObject("ADODB.Connection")
    connDB.Open ConnectionString:="Provider = Microsoft.ACE.OLEDB.12.0; data source=" & CurrentAccessDB
  [COLOR=#0000ff]  Set[/COLOR] adoRecSet = CreateObject("ADODB.Recordset")
   
[COLOR=#008000]    'Delete Old Locations Table[/COLOR]
    connDB.Execute "DROP TABLE Locations;"
                      
[COLOR=#008000]                      'Create New Table[/COLOR]
                      strSql = vbNullString
                      strSql = "CREATE TABLE Locations([Address_1] TEXT(200)"
                      strSql = strSql & vbLf & ", [Address_2] TEXT(200)"
                      strSql = strSql & vbLf & ", [Address_City] TEXT(50)"
                      strSql = strSql & vbLf & ", [Address_Email] TEXT(75)"
                      strSql = strSql & vbLf & ", [Address_State] TEXT(2)"
                      strSql = strSql & vbLf & ", [Address_Zip] TEXT(25)"
                      strSql = strSql & vbLf & ", [ID] TEXT(12)"
                      strSql = strSql & vbLf & ", [Name_Location] TEXT(200)"
                      strSql = strSql & vbLf & ", [Name_Location_Short] TEXT(200)"
                      strSql = strSql & vbLf & ", [Number_Fax] TEXT(25)"
                      strSql = strSql & vbLf & ", [Number_Pager] TEXT(25)"
                      strSql = strSql & vbLf & ", [Number_Phone_Cell] TEXT(25)"
                      strSql = strSql & vbLf & ", [Number_Phone_Home] TEXT(25)"
                      strSql = strSql & vbLf & ", [Flag_Status] TEXT(25)"
                      strSql = strSql & vbLf & ", [Number_Phone_Work] TEXT(25)"
                      strSql = strSql & vbLf & ", [Flag_AutoFax] TEXT(200)"
                      strSql = strSql & vbLf & ", [Location_Account] TEXT(200)"
                      strSql = strSql & vbLf & ", [Timestamp_Creation] DATETIME"
                      strSql = strSql & vbLf & ", [Notes] TEXT(255));"
                 
                      connDB.Execute strSql
                      
          [B][COLOR=#ff0000]  adoRecSet.Open "Locations", connDB, adOpenKeyset, adLockOptimistic, adCmdTable  'Open Table

[/COLOR][/B]         [COLOR=#008000]  'Code to write records here.....[/COLOR]

Thanks for taking the time to look at this for me.

 

[Joe4]

Why drop the table, only to recreate it and re-populate it?
Why not just clear the existing records from the table, but leaving the table structure intact?

DELETE [Locations].*
FROM Locations;

Also, I am just curious as to why you are using VBA to do this instead of just Macros/Action Queries? Seems like it could be done a little easier, but maybe you have your reasons.

 

[mrmmickle1]

Joe4,

Thanks for the quick reply. I am just starting to use MS Access so I am probably going about this the hard way as you mentioned. What do you mean by using Macros/Action Queries I would certainly be interested in learning more about these if you believe it would help my situation.

I have added your update to the below code, but still get an error on the red line. Is there an easier way to go about this?

[COLOR=#0000ff]Public Sub [/COLOR]AccessTableUpdate()


    [COLOR=#0000ff]Dim[/COLOR] CurrentAccessDB [COLOR=#0000ff]  As String[/COLOR]
   [COLOR=#0000ff] Dim [/COLOR]adoRecSet        [COLOR=#0000ff] As Object[/COLOR] [COLOR=#008000]'As New ADODB.Recordset[/COLOR]
    [COLOR=#0000ff]Dim [/COLOR]connDB            [COLOR=#0000ff]As Object[/COLOR] [COLOR=#008000]'As New ADODB.Connection[/COLOR]
  [COLOR=#0000ff]  Dim[/COLOR] rng               [COLOR=#0000ff]As [/COLOR]Range
   [COLOR=#0000ff] Dim[/COLOR] i               [COLOR=#0000ff]  As Long[/COLOR]
  [COLOR=#0000ff]  Dim[/COLOR] lFieldCount       [COLOR=#0000ff]As Long[/COLOR]
 [COLOR=#0000ff]   Dim [/COLOR]dbConnectStr      [COLOR=#0000ff]As String[/COLOR]

    CurrentAccessDB = "C:\Users\mmickle\Desktop\PCLS_Master_Review_Database.mdb"
    dbConnectStr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & CurrentAccessDB & ";"
  [COLOR=#0000ff]  Set [/COLOR]connDB = CreateObject("ADODB.Connection")
    connDB.Open dbConnectStr
  [COLOR=#0000ff]  Set[/COLOR] adoRecSet = CreateObject("ADODB.Recordset")

[COLOR=#008000]    'Delete Old Locations Records[/COLOR]
    connDB.Execute "DELETE [Locations].* FROM Locations;"
    
[B][COLOR=#ff0000]            adoRecSet.Open "Locations", connDB, adOpenKeyset, adLockOptimistic, adCmdTable 'All records in a table[/COLOR][/B]
         
            r = 2 [COLOR=#008000]'Start Row[/COLOR]
         [COLOR=#0000ff]   Do While [/COLOR]Len(Range("G" & r).Formula) > 0 [COLOR=#008000] 'Repeat until first empty cell in column G[/COLOR]
           
                [COLOR=#0000ff]With [/COLOR]adoRecSet
                    .AddNew [COLOR=#008000]' create a new record[/COLOR]
[COLOR=#008000]                      ' add values to each field in the record[/COLOR]
                      .Fields("Address_1") = Range("A" & r).Value
                      .Fields("Address_2") = Range("B" & r).Value
                      .Fields("Address_City") = Range("C" & r).Value
                      .Fields("Address_Email") = Range("D" & r).Value
                      .Fields("Address_State") = Range("E" & r).Value
                      .Fields("Address_Zip") = Range("F" & r).Value
                      .Fields("ID") = Range("G" & r).Value
                      .Fields("Name_Location") = Range("H" & r).Value
                      .Fields("Name_Location_Short") = Range("I" & r).Value
                      .Fields("Number_Fax") = Range("J" & r).Value
                      .Fields("Number_Pager") = Range("K" & r).Value
                      .Fields("Number_Phone_Cell") = Range("L" & r).Value
                      .Fields("Number_Phone_Home") = Range("M" & r).Value
                      .Fields("Flag_Status") = Range("N" & r).Value
                      .Fields("Number_Phone_Work") = Range("O" & r).Value
                      .Fields("Flag_AutoFax") = Range("P" & r).Value
                      .Fields("Location_Account") = Range("Q" & r).Value
                      .Fields("Timestamp_Creation") = Range("R" & r).Value
                      .Fields("Notes") = Range("S" & r).Value
                      .Update [COLOR=#008000]' stores the new record[/COLOR]
                    
[COLOR=#0000ff]                End With[/COLOR]
                r = r + 1[COLOR=#008000] ' next row[/COLOR]

[COLOR=#0000ff]            Loop[/COLOR]

Any advice or guidance would be appreciated!

 

[TerryHogarth21]

Have a read up on some of the Microsoft references below. This is pretty handy for anybody and I even reference back to it since it gives good examples.
Create queries for a new database - Access

The Access Program has the functionality built in already to generate the items that you are trying to do.

Rather than write code for it, let the program operate by utilizing the already given functionality.

 

[Joe4]

I think may be able to do all of this without any VBA code at all.

For the record deletion step:
- Create a new Macro object
- Choose the "SetWarnings" Action, and set the value to "No"
- On the next row, choose the "RunSQL" Action (if you do not see this in your list of Actions, click on the "Show All Actions" button in the Show/Hide ribbon).
- Enter the SQL code I gave you above in the SQL Statement option: "DELETE [Locations].* FROM Locations;"
- Choose the "SetWarnings" Action, and set the value to "Yes"
- Save and close your Macro

It looks like all your fields in your Excel file match up nicely with the fields in your Access table. So you should be able to import your Excel file directly into your Access table. If you go back in to your Macro and add a "TransferSpreadsheet" Action, this will import the Excel file into your Access table (just fill out the appropriate arguments - it has helpful hints and you can use F1 to get more details).

Now, any time you run this macro, it will delete all the records in your table and then import your Excel file into your Access table.

 

[mrmmickle1]

TerryHogarth21,

Thank you for the link. I will review this when I get home this evening. I am excited to learn a few new tricks

Joe4,

Thanks for the step by step instructions. After, I create a macro I see the listbox that says Add New Action however, there is not an option for "SetWarnings" There is a pretty big list that incorporates:

SetDisplayedCategories
SetFilter
SetLocalVar
SetMenuItem
SetOrderBy
SetProperty
SetTempVar

I am using Access 2013. Is there another action I should select to accomplish my goal?

EDIT: I found the option by Typing it in manually.... I will report back momentarily with my results.

 

[Joe4]

Check out the note I posted in the next step (apparently, it applies to SetWarnings too):

if you do not see this in your list of Actions, click on the "Show All Actions" button in the Show/Hide ribbon

 

[mrmmickle1]

Joe4,

I was able to take the steps you mentioned in the above post. I may need just a little more help to get to my end goal.

The file is a delimited .CSV export from my company database ---> I have existing code that will delimit this file
The range changes ---> I can define the table with code in order to make it dynamic

LastRow = Range("G" & Rows.Count).End(xlUp).Row
ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$1:$S$" & LastRow), , xlYes).Name = "Table1"

The SQL statement to delete records works good.
The information from the table in the excel file works but it imports the table as Table1. (Access would not let me run the macro without naming the table in the excel file)

This is what Access converted the Macro to:

[COLOR=#0000ff]Function [/COLOR]Update_Locations()
[COLOR=#0000ff]On Error GoTo [/COLOR]Update_Locations_Err

    DoCmd.SetWarnings [COLOR=#0000ff]False[/COLOR]
    DoCmd.RunSQL "DELETE [Locations].* FROM Locations;", -1
    DoCmd.SetWarnings [COLOR=#0000ff]True[/COLOR]
    DoCmd.TransferSpreadsheet acImport, 10, "", "C:\Users\mmickle\Desktop\Locations.xlsx", True, ""

Update_Locations_Exit:
  [COLOR=#0000ff]  Exit Function[/COLOR]

Update_Locations_Err:
    MsgBox Error$
    Resume Update_Locations_Exit
[COLOR=#0000ff]
End Function[/COLOR]

How can I change the macro to import the information into the Locations Table instead of as a new table?

Any help would be much appreciated!

 

[Joe4]

How can I change the macro to import the information into the Locations Table instead of as a new table?

Populate that argument instead of leaving it blank like you did in your code (""). It is the third argument.
See: DoCmd.TransferSpreadsheet Method (Access)

The file is a delimited .CSV export from my company database ---> I have existing code that will delimit this file

This may not be necessary. It sounds like you are converting the CSV to an Excel file, and then importing the Excel file. Is that right? You may be able to import the CSV file directly in to your Access table (and bypass that intermediate step altogether). That uses the "TransferText" Action, which works similar to TransferSpreadsheet.

 

[mrmmickle1]

Joe4,

I have been trying to do as you mentioned however I have run into some issues with the macro.

My file is a .CSV file which is delimited by a "|" (A Pipe Symbol). My data has 19 fields. There are Field Names as headers

I am unsure what some of the arguments mean. Where do I put the delimiter? I looked at Microsoft Help and googled a few different articles but was unable to get my issues resolved:

For the ImportExportText Action the arguments that I have are:

Transfer Type:Import Delimited
Specification Name:
Table Name: Locations
File Name: C:\Users\mmickle\Desktop\Locations.csv
Has Field Names: Yes
HTML Table Name:
Code Page:

This is the recorded macro:

[COLOR=#0000ff]Function [/COLOR]TestMacro()
[COLOR=#0000ff]On Error GoTo[/COLOR] TestMacro_Err

    DoCmd.SetWarnings [COLOR=#0000ff]False[/COLOR]
    DoCmd.RunSQL "DELETE [Locations].* FROM Locations;", -1
    DoCmd.SetWarnings [COLOR=#0000ff]True[/COLOR]
    DoCmd.TransferText acImportDelim, "", "Locations", "C:\Users\mmickle\Desktop\Locations.csv", [COLOR=#0000ff]True[/COLOR], ""

TestMacro_Exit:
[COLOR=#0000ff]    Exit Function[/COLOR]

TestMacro_Err:
    MsgBox Error$
 [COLOR=#0000ff]   Resume[/COLOR] TestMacro_Exit

[COLOR=#0000ff]End Function[/COLOR]

When I run it the macro says that field 'ÿþA' does not exist in destination table 'Locations'. However, I don't see this text in the csv file....