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]

Go through the process of manually importing a file once, so that the Import Wizard is invoked. Then go through all the settings, when you choose the delimiter, etc. Then, just before you click "Finish", click on the "Advanced" tab, and then Save the Import Specification you just created. You then use that name in the "Specification Name" field.

 

[mrmmickle1]

I tried to complete this task and I set the import to save as you mentioned but when I click to complete the action I get an error:

I looked at the data and was unable to determine the issue. The Import wizard says:

Two things: Subscript out of range and or Primary key or index cannot contain a null value

On the Advanced Tab I selected:

File Format:

Delimited = True
Field Delimeter = |
Text Qualifier = "
Language = English
Code Page = Unicode

Date Order= MDY
Date Delimiter= /
Time Delimter = :
Four Digit Years = True
Leaading Seros in Dates = False
Decimal Symbol = .

The Table Fields All have these attributes:

Required = No
Allow Zero Length = Yes
Indexed = No

I have not made a primary key.

The Field Names are:
Address_1|Address_2|Address_City|Address_Email|Address_State|Address_Zip|ID|Name_Location|Name_Location_Short|Number_Fax|Number_Pager|Number_Phone_Cell|Number_Phone_Home|Number_Phone_Work|Flag_Status|Flag_AutoFax|TimeStamp_Creation|Location_Account|Notes

Some of the fields contain paragraph symbols.

 

[Joe4]

Is there a Primary Key in your Locations table?

The steps I told you above to create the Import Specification, after saving it, it is still a good idea to click "Finish", just to test if it works.
If it does not, you still have some work to do on your Import Specification.

Note, when going through the steps, if you are importing to an existing table, make sure you indicate that in the first step of the Import Wizard when creating your Import Specification. Otherwise, you may be creating a specification for creating a new table instead of importing to an existing one.

I don't know what paragraph symbols will do, if they will create problems or not.

 

[mrmmickle1]

Joe4,

I have tried getting the import to work for a few hours now. Not sure what is wrong with the data. My co-workers told me their was some kind of issue that prevents them from importing it as well. I can't pinpoint the issue.

I kept getting both of the errors that I previously mentioned.... I tried changing the export a few different ways and no luck on all fronts....

I can see how this would be greatly beneficial if I could get it to work

I was able to complete the method as I planned to earlier. I believe this to be largely inefficient based on previous posts in this thread. It does not give me errors though. It seems I forgot to insert the global constants into the module and this is why I was getting the error previously:

[COLOR=#ff0000][B]Option Explicit[/B][/COLOR]
[COLOR=#ff0000][/COLOR]
[COLOR=#ff0000][B]Const adOpenKeyset = 1[/B][/COLOR]
[COLOR=#ff0000][B]Const adCmdTable = 2                  <-------These were what I was missing[/B][/COLOR]
[COLOR=#ff0000][B]Const adLockOptimistic = 3[/B][/COLOR]


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


    [COLOR=#0000ff]Dim [/COLOR]dbpath            [COLOR=#0000ff]As String[/COLOR]
    [COLOR=#0000ff]Dim [/COLOR]dbconnectStr      [COLOR=#0000ff]As String[/COLOR]
    [COLOR=#0000ff]Dim[/COLOR] rs                [COLOR=#0000ff]As Object[/COLOR]
 [COLOR=#0000ff]   Dim[/COLOR] cn                [COLOR=#0000ff]As Object[/COLOR]
    [COLOR=#0000ff]Dim [/COLOR]r                 [COLOR=#0000ff]As Long[/COLOR]


    dbpath = "C:\Users\" & Environ("UserName") & "\Desktop\Test.accdb"
    dbconnectStr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dbpath & ";"
    [COLOR=#0000ff]Set[/COLOR] cn = CreateObject("ADODB.Connection")
    cn.Open dbconnectStr
  [COLOR=#0000ff]  Set[/COLOR] rs = CreateObject("ADODB.Recordset")
[COLOR=#008000]    [/COLOR]
[COLOR=#008000]    'Delete Old Locations Table[/COLOR]
    cn.Execute "DELETE [Locations].* FROM Locations;"
                                         
            rs.Open "Locations", cn, [COLOR=#ff0000][B]adOpenKeyset, adLockOptimistic, adCmdTable [/B][/COLOR][COLOR=#008000]'All records in table[/COLOR]
            r = 2 [COLOR=#008000]'Start Row[/COLOR]
            Do While Len(Range("G" & r).Formula) > 0 [COLOR=#008000]'Repeat until first empty cell in column A[/COLOR]
           
                With rs
                    .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("Timestamp_Creation") = Range("Q" & r).Value
                      .Fields("Location_Account") = 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]
            
[COLOR=#008000]         'Close Connections[/COLOR]
         rs.Close
         cn.Close
               
[COLOR=#008000]    'Clear Memory[/COLOR]
    dbpath = vbNullString
    dbconnectStr = vbNullString
   [COLOR=#0000ff] Set[/COLOR] rs = [COLOR=#0000ff]Nothing[/COLOR]
    [COLOR=#0000ff]Set [/COLOR]cn = [COLOR=#0000ff]Nothing[/COLOR]
    r =[COLOR=#0000ff] Empty[/COLOR]


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

 

[Joe4]

Sorry we couldn't get the other method to work. It can be hard to help out on these things when you don't have access to the data file. Many times, the issues lies with the data.

Glad your other method to work out though.

 

[mrmmickle1]

Joe4,

Not all is lost. You were able to teach me a lesson in SQL and allow me to get more experience with the MS Access Macro Interface. Although it seems awkward at first, it appears to be quite powerful and useful. It has my interest piqued. I will continue to try my hand at it, until I'm more efficient!

I will try to use this method with a set of data that is not corrupted. That way I can see if it will work for future projects.

 

[mrmmickle1]

Thank you for all of your help Joe4 and TerryHogarth21. I learned a lot just by trying different methods. I appreciate the helping hands!

 

[Joe4]

You are most welcome!

 

[mrmmickle1]

In case your interested. I tried again today for a few hours using a different source file with data that I believed to be corruption free... It seems there is something wrong with the way my company's database exports information. I was able to export the new data as an .xlsx after I delimited the .csv file. Is there some kind of compatibility issue with the way that Excel Delimits data as opposed to the way that Access delimits data?

Here Is A Link to the MS Access Thread

 

[Joe4]

Looks like you are getting some good information from those guys over there.