Access VBA Create Table

This example is a response from an email I received regarding:

“How to build a table by extracting some fields from a main database…”

I interpret it as: “Query a main database (mainframe) and create a local table.”


I do have another easier version of this process at “How To Create A Table In Access Using SQL And VBA”

Take a look, and get the example database below:

Option Compare Database
'========================================================
'DATABASE DESIGNED & CODED BY LOEBLCOM SERVICES 2013
'ERIK LOEBL(713)409-7041
'EMAIL: erik@loeblcomservices.com
'WEB: http://loeblcomservices.com
'========================================================

Private Sub btnCreateTable_Click()

	'OBJECTIVE: to build a table by extracting some fields from a main database

	Dim rst As Recordset
	Dim strSQL As String
	Dim intCount As Integer
	Dim intNumFields As Integer

	Dim i As Integer
	Dim strRecords() As String
	Dim strFields As String

	Dim intStatus As Integer

	'A query to a "main frame computer"
	strSQL = "SELECT DISTINCT [Last Name],[First Name],Address,City,[State/Province] FROM Customers "

	Set rst = CurrentDb.OpenRecordset(strSQL)

	'LOAD ARRAY FOR FIELD NAMES FROM THE RST

	'FIND THE # OF RECORDS IN THIS SET...
	rst.MoveLast
	rst.MoveFirst

	'Total number of records in this recordset
	intCount = rst.RecordCount - 1 '0-based
	i = 0

	intNumFields = rst.Fields.Count

	'strFields = rst.Fields(0).Name 'for 1 field name
	strFields = rst.Fields(0).Name & "," & rst.Fields(1).Name & "," & rst.Fields(2).Name & "," & rst.Fields(3).Name & "," & rst.Fields(4).Name

	Do Until rst.EOF

		'Store the values of the query in an array...
		ReDim Preserve strRecords(i)

		'strRecords(i) = rst.Fields(0) 'for 1 field
		strRecords(i) = rst.Fields(0) & "," & rst.Fields(1) & "," & rst.Fields(2) & "," & rst.Fields(3) & "," & rst.Fields(4)

		'Debug.Print strRecords(i)

		i = i + 1
		rst.MoveNext
	Loop

	rst.Close
	Set rst = Nothing

	'BUILD A CUSTOM TABLE BASED ON THE FIELD NAMES IN THE ARRAY...

	intStatus = CreateTable(strFields, strRecords(), intNumFields, Me.txtNewTableName)

	If intStatus = True Then

		MsgBox "Table created and data entered successfully"

	End If

End Sub


Public Function CreateTable(table_fields As String, table_data As Variant, num_fields As Integer, table_name As String) As Boolean
	Dim strCreateTable As String

	Dim intCount As Integer

	Dim strFields() As String
	Dim strValues() As String

	Dim strInsertSQL As String

	Dim intCounter As Integer
	Dim intData As Integer

	On Error GoTo errHandler

	'split the string on the comma delimiter
	strFields = Split(table_fields, ",")

	If TableExists(table_name) Then
		'DROP THE TABLE IF IT EXISTS.
		CurrentDb.Execute "DROP TABLE " & table_name
	End If

	'this creates the table structure...
	strCreateTable = "CREATE TABLE " & table_name & "("

	For intCounter = 0 To num_fields - 1
		strCreateTable = strCreateTable & "[" & strFields(intCounter) & "] varchar(150),"
	Next

	If Right(strCreateTable, 1) = "," Then
		strCreateTable = Left(strCreateTable, Len(strCreateTable) - 1)
		strCreateTable = strCreateTable & ")"
	End If

	CurrentDb.Execute strCreateTable

	intCounter = 0 'reset
	intData = 0 'reset

	If Err.Number = 0 Then

		For intData = 0 To UBound(table_data)

			'split the row on the comma delimiter
			strValues = Split(table_data(intData), ",")

			'=======================================================================
			'now insert the values into the new table
			'=======================================================================
			strInsertSQL = "INSERT INTO " & table_name & "("

			For intCounter = 0 To num_fields - 1
				strInsertSQL = strInsertSQL & "[" & strFields(intCounter) & "],"
			Next

			If Right(strInsertSQL, 1) = "," Then
				strInsertSQL = Left(strInsertSQL, Len(strInsertSQL) - 1)
				strInsertSQL = strInsertSQL & ")"
			End If

			'==================================================
			'now enter the values...
			'==================================================
			strInsertSQL = strInsertSQL & " VALUES ("

			intCounter = 0

			For intCounter = 0 To num_fields - 1
				strInsertSQL = strInsertSQL & """" & strValues(intCounter) & ""","

			Next

			If Right(strInsertSQL, 1) = "," Then
				strInsertSQL = Left(strInsertSQL, Len(strInsertSQL) - 1)
				strInsertSQL = strInsertSQL & ")"
			End If

			'==================================================
			'insert data row... '==================================================
			Debug.Print strInsertSQL
			CurrentDb.Execute strInsertSQL

		Next 'next data row

		CreateTable = True
	End If

	Exit Function
	errHandler:
		CreateTable = False
		MsgBox Err.Number & " " & Err.Description

End Function

Public Function DropTable(strTableName) As Boolean
	Dim db As Object
	Dim td As Object

	Set db = CreateObject("DAO.DBEngine.36")
	Set db = CurrentDb

	'Find the table
	Set td = db.TableDefs(strTableName)

	'Drop the table
	CurrentProject.Connection.Execute "DROP TABLE [" & strTableName & "]"

	Set td = Nothing
	Set db = Nothing

	DropTable = True

End Function

Public Function TableExists(strTable As String) As Boolean
	Dim rst As Recordset
	Dim strSQL As String

	On Error GoTo errHandler

	'FOR SQL Server
	'strsql = "SELECT name FROM Msysobjects WHERE type='u' AND Name='Transformers'" for projects

	'FOR Access
	strSQL = "SELECT MSysObjects.Name FROM MSysObjects WHERE MSysObjects.Name='" & strTable & "'"

	Set rst = CurrentDb.OpenRecordset(strSQL)

	If Not rst.EOF Then
		TableExists = True
	Else
		TableExists = False
	End If

	rst.Close
	Set rst = Nothing

	Exit Function

	errHandler:
		TableExists = False
		MsgBox Err.Number & " " & Err.Description

End Function



Click here for the database and the code:
access-vba-create-table.mdb




By the way, if you got or are getting value from the VBA information, please give me a tip, thanks!


These posts may help answer your question too...

How To Escape Apostrophe In SQL Update Query

If you are looping a table with thousands of records, you’ll probably run into at least one that has an apostrophe in the field name. Like “Mike’s” or “M’cormick”, or something else. Anyway, here is one way to escape the string when you are doing your update query. Option Compare Database Sub YDriveLoop() ‘4/23/24 erik@loeblcomservices.com […]

How To Parse A Flat File In Excel VBA

In another post I demonstrated how to access a file on your computer using the MS Office Library. Here it is if you don’t know what I’m talking about. In this post, I am going to show you how to access the file and load it into your spreadsheet. I will do the same thing […]

How can I interact with other Office applications (Excel) using VBA in Access?

Need to write your Access data or query to an Excel file? Here is the how to do it: Most people are familiar with Excel and know how to use it well (enough), and when you start talking about Access, they get scared off, and don’t know what to do anymore. Well, here you are […]

How To Create A Parameter Query In Access

A parameter query changes your ordinary static access query to be more dynamic and interactive. It will ask you a question about what you want to search for, allowing you to do a search query multiple times instead of just once. You can do your parameter query straight from the QBE (Query By Example) Editor, […]

Previous Post

VBA Move File

Next Post

MS Access Login Form Revised