<da***@rightsort.com> wrote in message
news:11**********************@z14g2000cwz.googlegr oups.com...
I already know what type of data these fields will be populated with,
for example one field will be populated with a date but this will only
be done via certain processes once the table has been imported into
access.
Basically all I want to be able to do is to use VB to set the data type
for certain fields rather than doing it through the design view of the
table. If anyone knows what the code is for this then please could
they let me know.
Thanks
David.
You can use data definition queries, for example:
CurrentDb.Execute "ALTER TABLE MyTable ALTER COLUMN MyColumn INTEGER"
To alter existing columns, but you can do more things with the table if you
use DAO. You cannot convert existing columns but as there is no data, you
might as well re-create a blank table with the required types. In the
function below, the field names are taken from the spreadsheet column
headings. The type is set in a fixed manner - ie column 1 is a long
integer, column 2 is text, etc. You call the function like this:
?CreateTable("C:\MyStuff\MyBook.xls","Sheet1","tbl MyTable")
I did send an e-mail offering to send an example mdb - did it not get
through?
Public Function CreateTable(strExcelPath As String, _
strExcelSheet As String, _
strAccessTable As String) As Boolean
On Error GoTo Err_Handler
Dim dbs As DAO.Database
Dim tdfLink As DAO.TableDef
Dim tdfLocal As DAO.TableDef
Dim fldLink As DAO.Field
Dim fldLocal As DAO.Field
Dim strLinkTable As String
Dim strFieldName As String
Dim lngCount As Long
strLinkTable = "~tmp" & Format(Now(), "yyyymmddhhnnss")
Set dbs = CurrentDb
Set tdfLink = dbs.CreateTableDef(strLinkTable)
tdfLink.Connect = "Excel 5.0;HDR=YES;IMEX=2;DATABASE=" & strExcelPath
tdfLink.SourceTableName = strExcelSheet & "$"
dbs.TableDefs.Append tdfLink
dbs.TableDefs.Refresh
Set tdfLocal = dbs.CreateTableDef(strAccessTable)
For Each fldLink In tdfLink.Fields
strFieldName = fldLink.Name
lngCount = lngCount + 1
Select Case lngCount
Case 1
Set fldLocal = tdfLocal.CreateField(strFieldName, dbLong)
tdfLocal.Fields.Append fldLocal
Case 2
Set fldLocal = tdfLocal.CreateField(strFieldName, dbText, 50)
tdfLocal.Fields.Append fldLocal
Case 3
Set fldLocal = tdfLocal.CreateField(strFieldName, dbDate)
tdfLocal.Fields.Append fldLocal
Case 4
Set fldLocal = tdfLocal.CreateField(strFieldName, dbCurrency)
tdfLocal.Fields.Append fldLocal
End Select
Next fldLink
dbs.TableDefs.Append tdfLocal
CreateTable = True
Exit_Handler:
On Error Resume Next
dbs.TableDefs.Delete strLinkTable
Set fldLink = Nothing
Set tdfLink = Nothing
Set fldLocal = Nothing
Set tdfLocal = Nothing
Set dbs = Nothing
Application.RefreshDatabaseWindow
Exit Function
Err_Handler:
MsgBox Err.Description, vbExclamation, "Error No: " & Err.Number
Resume Exit_Handler
End Function
