Create a SQL Table from Excel VBA - vba

The problem is that I cannot get the table name that was entered into the variable, "tblName", to be used instead I get a correctly named database with a table named "tblName".
Is there some way to pick up the name in "tblName" or some way to change the name once it is created with a name th user enters?
Private Sub CreateDatabaseFromExcel()
Dim dbConnectStr As String
Dim Catalog As Object
Dim cnt As ADODB.Connection
Dim dbPath As String
Dim tblName As String
'Set database name in the Excel Sheet
dbPath = ActiveSheet.Range("B1").Value 'Database Name
tblName = ActiveSheet.Range("B2").Value 'Table Name
dbConnectStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbPath & ";"
'Create new database using name entered in Excel Cell ("B1")
Set Catalog = CreateObject("ADOX.Catalog")
Catalog.Create dbConnectStr
Set Catalog = Nothing
'Connect to database and insert a new table
Set cnt = New ADODB.Connection
With cnt
.Open dbConnectStr
.Execute "CREATE TABLE tblName ([BankName] text(50) WITH Compression, " & _
"[RTNumber] text(9) WITH Compression, " & _
"[AccountNumber] text(10) WITH Compression, " & _
"[Address] text(150) WITH Compression, " & _
"[City] text(50) WITH Compression, " & _
"[ProvinceState] text(2) WITH Compression, " & _
"[Postal] text(6) WITH Compression, " & _
"[AccountAmount] decimal(6))"
End With
Set cnt = Nothing
End Sub

Change this line:
.Execute "CREATE TABLE tblName ([BankName] text(50) WITH Compression, " & _
To this:
.Execute "CREATE TABLE " & tblName & " ([BankName] text(50) WITH Compression, " & _

Related

Issue Referencing Column in VBA SQL Query

I have an excel spreadsheet that I'm trying to perform SQL queries on. I get "no value given for one or more required parameters", so I think it's a problem with my query. I can do a query like "SELECT * FROM [Employee$A2:A4]", but when I reference a particular column using the name (i.e. name, title...etc, or even using the generic column reference like F1) I get "No value given for one or more required parameters."
Here's my code:
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
strFile = ThisWorkbook.FullName
strCon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strFile _
& ";Extended Properties=""Excel 12.0;HDR=Yes;IMEX=1"";"
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
cn.Open strCon
strSQL = "SELECT Employee FROM [Employee$] AS e WHERE e.Skill_Title = " & """" & skillTitle & """" & " AND e.Branch = " & """" & branchTitle & """" & " AND e.Skill_Prof = 5"
rs.Open strSQL, cn
MsgBox (rs.GetString)
Any ideas what might be going on?
Try applying the following example.
Tell me if the problem persists and the inputs you're using.
I have this on Employee sheet:
Created "MyQuery" subprocess as follows (as you can see, this is a replica of your code, with some little differences):
Sub MyQuery(ByVal skillTitle As String, _
ByVal branchTitle As String, _
ByVal skillProf As Integer)
Dim Cn As ADODB.Connection
Dim Rs As ADODB.Recordset
strFile = ThisWorkbook.FullName
strCon = _
"Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & strFile & ";" & _
"Extended Properties=""Excel 12.0;" & _
"HDR=Yes;" & _
"IMEX=1"";"
Set Cn = CreateObject("ADODB.Connection")
Set Rs = CreateObject("ADODB.Recordset")
Cn.Open strCon
strSQL = _
"SELECT Employee " & _
"FROM [Employee$] AS e " & _
"WHERE e.Skill_Title = '" & skillTitle & "' AND " & _
"e.Branch = '" & branchTitle & "' AND " & _
"e.Skill_Prof = " & CStr(skillProf)
Rs.Open strSQL, Cn
MsgBox (Rs.GetString)
'Do not forget closing your connection'
Rs.Close
Cn.Close
End Sub
Made a quick test:
Sub test()
'Try running this'
Call MyQuery("FOUR", "Y", 5)
End Sub
Result:
Have you named the columns? I wasn't sure from your code example whether you had named the columns or were assuming the column header would suffice for a reference. A "named" column is not the same as using a column header. To access the column by name try assigning a name to the column first.
From: How to give a name to the columns in Excel
Click the letter of the column you want to change and then click the "Formulas" tab.
Click "Define Name" in the Defined Names group in the Ribbon to open the New Name window.
Enter the new name of the column in the Name text box.

How to CREATE TABLE using sql/VBA in excel with ADO

I'm trying to erase table content and replace it with new content in an excel sheet.
The code doesn't raise any errors however everytime I run it, it inserts some blanck cells before the source table.
The 'base.xlsx' table sheet looks like this :
If target.xlsx is void before running the code I get what I want however if I run it again I get this :
Here is the code :
Sub SQLQUERY()
Dim Cn As ADODB.Connection
Dim QUERY_SQL As String
Dim ExcelCn As ADODB.Connection
SourcePath = "C:\Path\to\base.xlsx"
TargetPath = "C:\Path\to\target.xlsx"
CHAINE_HDR = "[Excel 12.0;Provider=Microsoft.ACE.OLEDB.12.0;Mode=Read;Extended Properties='HDR=YES;'] "
Set Cn = New ADODB.Connection
STRCONNECTION = _
"Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source='" & SourcePath & "';" & _
"Mode=Read;" & _
"Extended Properties=""Excel 12.0;"";"
Colonnes = "[Col#1], Col2"
QUERY_SQL = _
"SELECT " & Colonnes & " FROM [base$] " & _
"IN '" & SourcePath & "' " & CHAINE_HDR
MsgBox (QUERY_SQL)
Cn.Open STRCONNECTION
Set ExcelCn = New ADODB.Connection
ExcelCn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & TargetPath & ";" & _
"Extended Properties=""Excel 12.0;HDR=YES;"""
ExcelCn.Execute "DROP TABLE [sheet$]"
ExcelCn.Execute "CREATE TABLE [sheet$] ([C1] Float, [C2] Float, [C3] Float)"
Cn.Execute "INSERT INTO [sheet$] (C1, C3) IN '" & TargetPath & "' 'Excel 12.0;' " & QUERY_SQL
'--- Fermeture connexion ---
Cn.Close
ExcelCn.Close
End Sub
After some research I discovered what's going on with the code. When Drop Table is executed Excel keep the "active range" and thus INSERT INTO will insert data after the active range.
To counter this we need to specify a range with the table name :
ExcelCn.Execute "DROP TABLE [sheet$]"
ExcelCn.Execute "CREATE TABLE [sheet$] ([C1] Float, [C2] Float, [C3] Float)"
Cn.Execute "INSERT INTO [sheet$A1:ZZ1] (C1, C3) IN '" & TargetPath & "' 'Excel 12.0;' " & QUERY_SQL
'--- Fermeture connexion ---
Note the [sheet$A1:ZZ1] in the sql statement.

Naming a access Table From textbox's text

I am Trying to create New access table in a database but when i try to name it from text box it is giving an error
Sub CreateTable()
Dim strCreate As String = "CREATE TABLE" & TxtBoxTblName.Text &(" & _
"CountryName varchar(120) Primary key," & _
"Continent Integer," & _
"Area Long," & _
"Population Long," & _
"Capital varchar(80)," & _
"Code char(2));"
Dim conDatabase As OleDbConnection = New OleDbConnection("Provider=Microsoft.JET.OLEDB.4.0;" & _
"Data Source=""Data Source=" & filename & ".mdb;")
Dim cmdDatabase As OleDbCommand = New OleDbCommand(strCreate, conDatabase)
conDatabase.Open()
cmdDatabase.ExecuteNonQuery()
conDatabase.Close()
MessageBox.Show("Table Created Sucessfully")
End Sub
I guess you missed a " in this line "CREATE TABLE" & TxtBoxTblName.Text &(" & _ and these in no space after CREATE TABLE keyword that will also yields error. so it should be "CREATE TABLE " & TxtBoxTblName.Text &"(" & _ See the difference here or try below code
Dim STR_DDL As String
STR_DDL = "CREATE TABLE #TABLENAME# (CountryName varchar(120) Primary key,Continent Integer,Area Long,Population Long,Capital varchar(80),Code char(2));"
STR_DDL.Replace("#TABLENAME#", Trim(TxtBoxTblName.Text))
OR
using Composite Formatting
Dim STR_DDL As String = String.Format("CREATE TABLE {0} (CountryName varchar(120) Primary key " & _
",Continent Integer,Area Long,Population Long,Capital varchar(80) " & _
",Code char(2));", Trim(TxtBoxTblName.Text))
{0} is a place holder for TxtBoxTblName.Text
and use it
Dim cmdDatabase As OleDbCommand = New OleDbCommand(STR_DDL , conDatabase)

MS EXCEL to MS ACCESS .accdb Database from VBA SQL Syntax error

I am completely stuck and pulling out my hair on this one..
From Excel VBA I have two sets of code:
1- To Create a table is MS Access via a SQL statement
2- Populated newly created table with a For loop, also using SQL
The first set of code works perfectly, so I know that my connection string is working properly.
Here is the first set:
Sub Create_Table()
'Add Reference to Microsoft ActiveX Data Objects 2.x Library
Dim strConnectString As String
Dim objConnection As ADODB.Connection
Dim strDbPath As String
Dim strTblName As String
Dim wCL As Worksheet
Dim wCD As Worksheet
Set wCL = Worksheets("Contract List")
Set wCD = Worksheets("Contract Data")
'Set database name and DB connection string--------
strDbPath = ThisWorkbook.Path & "\SpreadPrices.accdb"
'==================================================
strTblName = wCL.Range("TableName").Value
strConnectString = "Provider = Microsoft.ACE.OLEDB.12.0; data source=" & strDbPath & ";"
'Connect Database; insert a new table
Set objConnection = New ADODB.Connection
On Error Resume Next
With objConnection
.Open strConnectString
.Execute "CREATE TABLE " & strTblName & " (" & _
"[cDate] text(150), " & _
"[Open] text(150), " & _
"[High] text(150), " & _
"[Low] text(150), " & _
"[Last] text(150), " & _
"[cChange] text(150), " & _
"[Settle] text(150), " & _
"[cVolume] text(150), " & _
"[OpenInterest] text(150))"
End With
Set objConnection = Nothing
End Sub
Mentioned before that code works perfectly. The bug is on the following set of code used to populate the table.
Here it is:
Sub InsertSQL()
'Add Reference to Microsoft ActiveX Data Objects 2.x Library
Dim strConnectString As String
Dim objConnection As ADODB.Connection
Dim strDbPath As String
Dim strTblName As String
Dim lngRow As Long
Dim strSQL As String
Dim wCL As Worksheet
Dim wCD As Worksheet
Set wCL = Worksheets("Contract List")
Set wCD = Worksheets("Contract Data")
'Set database name and DB connection string--------
strDbPath = ThisWorkbook.Path & "\SpreadPrices.accdb"
'==================================================
strTblName = wCL.Range("TableName").Value
strConnectString = "Provider = Microsoft.ACE.OLEDB.12.0; data source=" & strDbPath & ";"
'Connect Database; insert a new table
Set objConnection = New ADODB.Connection
'On Error Resume Next
With objConnection
.Open strConnectString
For lngRow = 2 To Range("NumberRows").Value
strSQL = "INSERT INTO " & strTblName & " (" & _
"cDate, Open, High, Low, Last, cChange, Settle, cVolume, OpenInterest)" & _
" VALUES ('" & _
wCD.Cells(lngRow, 1) & "' , '" & _
wCD.Cells(lngRow, 2) & "' , '" & _
wCD.Cells(lngRow, 3) & "' , '" & _
wCD.Cells(lngRow, 4) & "' , '" & _
wCD.Cells(lngRow, 5) & "' , '" & _
wCD.Cells(lngRow, 6) & "' , '" & _
wCD.Cells(lngRow, 7) & "' , '" & _
wCD.Cells(lngRow, 8) & "' , '" & _
wCD.Cells(lngRow, 9) & "')"
wCL.Range("A1").Value = strSQL
.Execute strSQL
Next lngRow
End With
Set objConnection = Nothing
End Sub
The error I receive is:
Run-time error, Syntax error in INSERT INTO statement.
Ok, so at first thought I think there must be a error in my SQL string. So I take the exact SQL string and toss it into Access Query Builder and run the SQL command and it imports into the table just fine.
What am I missing?
The problem may be due to field names. There is a function named CDate. Open and Last are both Jet reserved words. See Problem names and reserved words in Access.
Enclose those problem field names in square brackets to avoid confusing the database engine:
"[cDate], [Open], High, Low, [Last], cChange, Settle, cVolume, OpenInterest)"
The brackets may be enough to get your INSERT working. However consider renaming the fields if possible.
That linked page also mentions Allen Browne's Database Issue Checker Utility. You can download that utility and use it to examine your database for other problem names. It can also alert you to other issues which may not affect the current INSERT problem, but could cause trouble in other situations.

Counter field in MS Access, how to generate?

How can I generate counter field like this 0001A, 0002A... becouse in standart it is 0,1,2,3,4.... how to change this?
Adding to #HansUp's excellent answer, you could hide the IDENTITY column and at the same time expose the formatted column using a SQL VIEW: you could then revoke privileges on the table so that users work with the VIEW and do not 'see' the table e.g. demo:
copy+paste into any VBA module, no references nor Access UI/object model required, creates a new mdb in the temp folder e.g. use Excel:
Sub YourView2()
On Error Resume Next
Kill Environ$("temp") & "\DropMe.mdb"
On Error GoTo 0
Dim cat
Set cat = CreateObject("ADOX.Catalog")
With cat
.Create _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & _
Environ$("temp") & "\DropMe.mdb"
With .ActiveConnection
Dim Sql As String
Sql = _
"CREATE TABLE YourTable ( " & _
"ID INTEGER IDENTITY(1, 1) NOT NULL UNIQUE, " & _
"data_col VARCHAR(20) NOT NULL);"
.Execute Sql
Sql = _
"CREATE VIEW YourView AS " & _
"SELECT FORMAT$(ID, '0000') & 'A' AS formatted_ID, " & vbCr & _
" data_col " & vbCr & _
" FROM YourTable;"
.Execute Sql
Sql = _
"INSERT INTO YourView (data_col) VALUES ('one');"
.Execute Sql
Sql = _
"INSERT INTO YourView (data_col) VALUES ('day');"
.Execute Sql
Sql = _
"INSERT INTO YourView (data_col) VALUES ('when');"
.Execute Sql
Sql = "SELECT * FROM YourView;"
Dim rs
Set rs = .Execute(Sql)
MsgBox rs.GetString
End With
Set .ActiveConnection = Nothing
End With
End Sub
I think this one would be even better if you include DDL GRANT/REVOKE samples to manage the privileges
Here's the updated code to do just that:
Sub YourView2()
On Error Resume Next
Kill Environ$("temp") & "\DropMe.mdb"
Kill Environ$("temp") & "\DropMeToo.mdw"
On Error GoTo 0
' Create workgroup and db
Dim cat As ADOX.Catalog
Set cat = CreateObject("ADOX.Catalog")
With cat
.Create _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Jet OLEDB:Engine Type=4;" & _
"Data Source=" & _
Environ$("temp") & "\DropMeToo.mdw;" & _
"Jet OLEDB:Create System Database=-1"
.Create _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Jet OLEDB:Engine Type=4;" & _
"Data Source=" & _
Environ$("temp") & "\DropMe.mdb;" & _
"Jet OLEDB:System Database=" & _
Environ$("temp") & "\DropMeToo.mdw;"
' Add table with data and user with privileges
With .ActiveConnection
Dim Sql As String
Sql = _
"CREATE TABLE YourTable ( " & _
"ID INTEGER IDENTITY(1, 1) NOT NULL UNIQUE, " & _
"data_col VARCHAR(20) NOT NULL);"
.Execute Sql
Sql = _
"CREATE VIEW YourView AS " & _
"SELECT FORMAT$(ID, '0000') & 'A' AS formatted_ID, " & vbCr & _
" data_col " & vbCr & _
" FROM YourTable WITH OWNERACCESS OPTION;"
.Execute Sql
.Execute "CREATE USER onedaywhen pwd Chri5tma5;"
.Execute "GRANT ALL PRIVILEGES ON YourView TO onedaywhen;"
.Execute "REVOKE ALL PRIVILEGES ON YourTable FROM onedaywhen;"
End With
End With
' Test user can connect
Dim con As ADODB.Connection
Set con = New ADODB.Connection
With con
.ConnectionString = _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Jet OLEDB:Engine Type=4;" & _
"Data Source=" & _
Environ$("temp") & "\DropMe.mdb;" & _
"Jet OLEDB:System Database=" & _
Environ$("temp") & "\DropMeToo.mdw;" & _
"User ID=onedaywhen;Password=pwd;"
.Open
On Error Resume Next
' Attempt to insert to table (no privileges)
Sql = _
"INSERT INTO YourTable (data_col) VALUES ('one');"
.Execute Sql
If Err.Number <> 0 Then
MsgBox _
Err.Number & ": " & _
Err.Description & _
" (" & Err.Source & ")"
End If
On Error GoTo 0
Dim rs
On Error Resume Next
' Attempt to read table (no privileges)
Sql = _
"SELECT * FROM YourTable;"
Set rs = .Execute(Sql)
If Err.Number <> 0 Then
MsgBox _
Err.Number & ": " & _
Err.Description & _
" (" & Err.Source & ")"
End If
On Error GoTo 0
' From here, work only with VIEW
Sql = _
"INSERT INTO YourView (data_col) VALUES ('one');"
.Execute Sql
Sql = _
"INSERT INTO YourView (data_col) VALUES ('day');"
.Execute Sql
Sql = _
"INSERT INTO YourView (data_col) VALUES ('when');"
.Execute Sql
Sql = "SELECT * FROM YourView;"
Set rs = .Execute(Sql)
MsgBox rs.GetString
Set con = Nothing
End With
End Sub
The simplest solution would be to use a standard autonumber field (long integer). Let Access maintain those values for you. Then anytime you need those values in your "0001A" format, use the Format() function to add the leading zeros, and concatenate an "A".
This is trivially easy. If your autonumber field is named ID, you could do that transformation with this query:
SELECT Format(ID, "0000") & "A" AS formatted_ID
FROM YourTable;
Similarly you can apply the same expression to the control source property of a text box on a form or report.
One solution, that works for forms only!
create a GetId() function that calculates your counter (using DMax generally)
Use the Before insert event in your form to set the value of the field using GetId()
Drawback: in a multiuser environment, if another User2 starts addind a record after User1, but saves it before User1 saves his, there will be a duplicate problem. You will need to use the FormError event to regenerate the ID and resume the save process.