Need code to create table from Excel file

[GraeagleBill]

I see Ranman256 post https://www.accessforums.net/showthread.php?t=54561 dealing with importing parts of an Excel file, but I just need the applicable code to essentially do what I would do in design mode starting with getting the Excel file option with "External Data" > "Import & Link" > "New Data Source" > "From File" > "Excel". Anyone have a simple code example where everything about the created table defaults from what is found in the Excel file?

[Welshgasman]

I have started asking ChatGPT instead of googling recently.

Here is what another user was using.
https://www.accessforums.net/showthread.php?t=90726

[GraeagleBill]

Searching on your suggestion, and finding this code example, the code gets the job done.

Option Compare Database
Option Explicit
Public Function MyFunc()


 ' Set variables
 Dim strTableName As String
 Dim strFileName As String
 Dim blnHasHeadings As Boolean


 'Set data
 strTableName = "tblMenuSheet"
 strFileName = "c:\SummersetApp\WeeklyMenu.xlsx"
 blnHasHeadings = True
 ' Import data
 DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, strTableName, strFileName       ', blnHasHeadings
 MsgBox "Excel file imported!", vbInformation


End Function

The only thing missing that I need in the new table is an added "ID" autonumber field.

[Welshgasman]

Well as you already appear to have a table, why not just add one?
I never use a Function unless I wish to return a value.

[GraeagleBill]

I never use a Function unless I wish to return a value.

I was only trying to get a code segment to do the job. Final implementation will likely just be inline during the larger scope of functionality.

I added a statement to add a column:

 CurrentDb.Execute "ALTER TABLE tblMenuSheet ADD Column MenuID;"

I get 3292 error: "Syntax error in field definition". I've done this sort of things in the past without errors, so I have no idea what the problem is? BTW, whats the data type expression for autonumber?

In the larger view of this new app, a new Excel file gets created each week. The app will NOT append, but rather delete the previous week's table and create anew. The add column therefore has to be repeated in code each week.

[Welshgasman]

No idea.
Why the need to do it in code and not manually?
Was the table created by the transfer?

From chatgpt

Sub AddAutoNumberField()
    Dim db As Database
    Dim tdf As TableDef
    Dim fld As Field
    
    ' Set the current database
    Set db = CurrentDb
    
    ' Reference the table you want to add the AutoNumber field to
    Set tdf = db.TableDefs("YourTableName") ' Replace with your table's name
    
    ' Add the AutoNumber field to the table
    Set fld = tdf.CreateField("AutoID", dbLong) ' AutoID is the name of the new field
    fld.Attributes = dbAutoIncrField ' This sets the field to AutoNumber
    
    ' Append the new field to the table
    tdf.Fields.Append fld
    
    ' Save and close
    db.TableDefs.Refresh
    MsgBox "AutoNumber field created successfully!", vbInformation
End Sub

[GraeagleBill]

Yes. The end user doesn't have any knowledge or access to the tabledefs in design mode. The entire process of establishing the needed table has to be entirely automatic. And yes, the import works perfectly, I just need an autonumber field added to the table.

[davegri]

I've had success with this. An added autonumber is not automatically made the primary key. You need more code to do that.

Public Function fcnMakePrimaryKey(tName As String, kName As String)
    On Error GoTo fcnMakePrimaryKey_Error
    Dim sSQL As String
    sSQL = "ALTER TABLE [" & tName & "] ADD COLUMN " & kName & " COUNTER"
    CurrentDb.Execute sSQL, dbFailOnError
    Application.CurrentDb.TableDefs.Refresh
    sSQL = "CREATE INDEX [$" & tName & "$] ON [" & tName & "] ([" & kName & "]) With Primary"
    DoEvents
    'Debug.Print sSQL
    CurrentDb.Execute sSQL, dbFailOnError
fcnMakePrimaryKey_EXIT:
    Exit Function
fcnMakePrimaryKey_Error:
    Select Case Err
        Case Else
            MsgBox "Error " & Err.Number & " (" & Err.Description & ")", vbExclamation, "Error in Function fcnMakePrimaryKey"
    End Select
    Resume fcnMakePrimaryKey_EXIT
End Function

[GraeagleBill]

When I first looked at your post, for some reason the only thing that displayed at my end was "From Chatgpt" but not the code? I will test that now..................

Works great using your post:

Option Compare Database
Option Explicit
Public Sub MySub()


 ' Set variables
 Dim strTableName As String
 Dim strFileName As String
 Dim dummy As Variant
 Dim blnHasHeadings As Boolean


 'Set data
 strTableName = "tblMenuSheet"
 strFileName = "c:\SummersetApp\WeeklyMenu.xlsx"
 blnHasHeadings = True
 ' Import data
 DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, strTableName, strFileName       ', blnHasHeadings
 
 'CurrentDb.Execute "ALTER TABLE tblMenuSheet ADD Column MenuID;"
 dummy = fcnMakePrimaryKey("tblMenuSheet", "MenuID")
 
 MsgBox "Excel file imported!", vbInformation


End Sub


Public Function fcnMakePrimaryKey(tName As String, kName As String)
    On Error GoTo fcnMakePrimaryKey_Error
    Dim sSQL As String
    sSQL = "ALTER TABLE [" & tName & "] ADD COLUMN " & kName & " COUNTER"
    CurrentDb.Execute sSQL, dbFailOnError
    Application.CurrentDb.TableDefs.Refresh
    sSQL = "CREATE INDEX [$" & tName & "$] ON [" & tName & "] ([" & kName & "]) With Primary"
    DoEvents
    'Debug.Print sSQL
    CurrentDb.Execute sSQL, dbFailOnError
fcnMakePrimaryKey_EXIT:
    Exit Function
fcnMakePrimaryKey_Error:
    Select Case Err
        Case Else
            MsgBox "Errors encountered" & Err.Number & " Desc " & Err.Description
    End Select
    Resume fcnMakePrimaryKey_EXIT
End Function