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.
Related
I'm working on an excel file to collect information from others closed Excel files
The provider is Microsoft.ACE.OLEDB.12.0 and everything works fine (almost).
In order to have updateable query, I used the command HDR = no in order to have column name like F1, F2, F3... and I retrieve the name after (see the code below, code from Stack Overflow).
However, with the command Union All, I also retrieved the headers as data, if I collect data from 5 files, I'll get 5 headers.
So I'm looking for a solution to retrieve header with command HDR = NO on Excel SQL query (start at line 2 in each file).
I tried OFFSET command in SQL query but I get an error message.
I also tried to get the row number in the original file but I didn't find the command.
Do you have any idea to help me on this issue?
Many thanks in advance,
BR
Code for information:
Option Explicit
Sub SqlUnionTest()
Dim strConnection As String
Dim strQuery As String
Dim objConnection As Object
Dim objRecordSet As Object
strConnection = _
"Provider=Microsoft.ACE.OLEDB.12.0;" & _
"User ID=Admin;" & _
"Data Source='" & ThisWorkbook.FullName & "';" & _
"Mode=Read;" & _
"Extended Properties=""Excel 12.0 Macro;"";"
strQuery = _
"SELECT * FROM [Sheet1$] " & _
"IN '" & ThisWorkbook.Path & "\Source1.xlsx' " & _
"[Excel 12.0;Provider=Microsoft.ACE.OLEDB.12.0;Mode=Read;Extended Properties='HDR=NO;'] " & _
"UNION " & _
"SELECT * FROM [Sheet1$] " & _
"IN '" & ThisWorkbook.Path & "\Source2.xlsx' " & _
"[Excel 12.0;Provider=Microsoft.ACE.OLEDB.12.0;Mode=Read;Extended Properties='HDR=NO;'] " & _
"UNION " & _
"SELECT * FROM [Sheet1$] " & _
"IN '" & ThisWorkbook.Path & "\Source3.xlsx' " & _
"[Excel 12.0;Provider=Microsoft.ACE.OLEDB.12.0;Mode=Read;Extended Properties='HDR=NO;'] " & _
"ORDER BY ContactName;"
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Open strConnection
Set objRecordSet = objConnection.Execute(strQuery)
RecordSetToWorksheet Sheets(1), objRecordSet
objConnection.Close
End Sub
Sub RecordSetToWorksheet(objSheet As Worksheet, objRecordSet As Object)
Dim i As Long
With objSheet
.Cells.Delete
For i = 1 To objRecordSet.Fields.Count
.Cells(1, i).Value = objRecordSet.Fields(i - 1).Name
Next
.Cells(2, 1).CopyFromRecordset objRecordSet
.Cells.Columns.AutoFit
End With
End Sub
You can specify the starting and ending row while querying the excel file. So Instead of -
SELECT * FROM [Sheet1$]
Use This -
SELECT * FROM [Sheet1$A2:end]
A2 - it will start reading from 2nd row.
end - will read until the sheet has data. So suppose, if you want to only some rows from SHEET1. Use this -
SELECT * FROM [Sheet1$A2:A10]
Please help; I wanted to copy an MS Access table and its data into another table at different MS Access database. I came across hundreds of access databases which has to be reformatted, I decided to write VB.Net code and format one table so that it can be copy to other hundreds instant of formatting one by one.
Here is my trial code:
Dim cmdCreate as New OleDb.OleDbCommand("SELECT * INTO [Hierarchy] IN "c:\hierarchy.pdb" FROM [Hierarchy] WHERE 0=1", con1)
cmdCreate.ExecuteNonQuery
Note: con1 datasource is deference with table2 directory.
here is a function in Access you can put a loop around with appropriate args. The dbSource and dbTarget are the full path names.
Public Function ExportTableToDatabase (TableName As String, dbSource As String, dbTarget As String, Optional Append As Boolean = False) As Boolean
On Error GoTo Error_Trap
Dim SQL As String
Dim db As DAO.Database
Set db = CurrentDb()
If Append Then
'The sql will use APPEND TO TABLE syntax
SQL = "INSERT INTO " & TableName & " IN """ & dbTarget & """ " _
& "SELECT " & TableName & ".* FROM " & TableName & " IN """ & dbSource & """ "
Else
'The sql will use CREATE TABLE syntax
SQL = "SELECT " _
& TableName & ".* INTO " & TableName & " " _
& "IN """ & dbTarget & """ " _
& "FROM " & TableName & " " _
& "IN """ & dbSource & """ "
End If
db.Execute SQL, dbFailOnError + dbSeeChanges
ExportTableToDatabase = True
Cleanup:
set db = nothing
Exit Function
Error_Trap:
msgbox Err.Number, Err.Description
Resume Cleanup
Resume
End Function
I am trying to populate a combobox in Excel file with data from SQL Server.
Here is code for event:
Private Sub Workbook_Open()
ActiveWorkbook.Sheets("Generation").Activate
Set cn = New ADODB.Connection
On Error Resume Next
With cn
.ConnectionString = "Provider=SQLOLEDB.1;" & _
"Integrated Security=SSPI;" & _
"Server=" & "192.160.160.150;" & _
"Database=" & "em_Consumer;" & _
"User Id= " & "User" & _
"Password = " & "server123"
.Open
End With
Set rs = New ADODB.Recordset
sqltextexec = " SELECT name FROM sys.tables WHERE schema_id = 7 AND name LIKE 'FinalCalculated%' ORDER BY create_date "
rs.Open sqltextexec, cn
rs.MoveFirst
With Sheets("Generation").ComboBox1
.Clear
Do
.AddItem rs![Name]
rs.MoveNext
Loop Until rs.EOF
End With
End Sub
This code works on my computer and on my colleague's as well (we are from DB team) but analysts who don't work with DB don't get list populated in the file.
Is it possible the program uses Windows authentication to connect to the DB?
Connection String Error
It seems there is an error in your connection string. The user ID needs to have a semi-colon after it.
Change this
With cn
.ConnectionString = "Provider=SQLOLEDB.1;" & _
"Integrated Security=SSPI;" & _
"Server=" & "192.160.160.150;" & _
"Database=" & "em_Consumer;" & _
"User Id= " & "User" & _
"Password = " & "server123"
To this
With cn
.ConnectionString = "Provider=SQLOLEDB.1;" & _
"Integrated Security=SSPI;" & _
"Server=" & "192.160.160.150;" & _
"Database=" & "em_Consumer;" & _
"User Id= " & "User;" & _
"Password = " & "server123"
That was an elusive little bugger.
Edit
I'm having trouble pinpointing the issue here, so perhaps a working example will better assist you at this point...
Function getSqlData(queryString As String, myUsername As String, myPassword As String, database As String) As Recordset
Dim conn As New ADODB.Connection
Dim rst As Recordset
Dim serverName As String
serverName = "192.160.160.150"
With conn
.ConnectionString = "Provider=SQLOLEDB.1;" & _
"Data Source=" & serverName & ";" & _
"Initial Catalog=" & database & ";User Id=" & myUsername & ";" & _
"Password=" & myPassword & ";Trusted_Connection=no"
.Open
End With
Set rst = conn.Execute(queryString)
Set getSqlData= rst
End Function
This will return your recordset.
today I tried to write it from scratch using #lopsided help. Here is the code:
Private Sub Workbook_Open()
ActiveWorkbook.Sheets("generation").Activate
Dim rstt As Recordset
MsgBox "1"
Set rstt = getData()
End Sub
-------------------------------------------------
Private Function getData()
Dim conn As New Connection
Dim rst As Recordset
Dim sqlstring As String
Dim rwcnt As Integer
MsgBox "2"
sqlstring = "SELECT productname FROM dbo.products WHERE recalc = 1"
With conn
.ConnectionString = "Provider=SQLOLEDB.1;" & _
"Data Source=192.160.160.150;" & _
"Initial Catalog=em_Consumer;" & _
"User Id=User;" & _
"Password=server!;" & _
"Trusted_Connection=no"
.Open
End With
MsgBox "3"
Set rst = conn.Execute(sqlstring)
rwcnt = rst.RecordCount
MsgBox rwcnt
MsgBox "5"
Set getData = rst
MsgBox "6"
End Function
So when i open the file I get messages:
1 which means that program started;
2 which means that it entered the function;
3 which means that there is no issues with connection;
!! then I get -1 value as record count which means that something is wrong
I tried to run this query in management studio and it returns 50 rows
Then program goes further and I get 5 and 6 ...
Do you have any ideas what is wrong with the code?
---------------------------------------------
Maybe it can help, code which works fine but returns table not recordset in the same document:
Sub Button3_Click()
ActiveSheet.Cells.Clear
Dim qt As QueryTable
sqlstring1 = "SELECT * FROM dbo.Report"
With ActiveSheet.QueryTables.Add(Connection:=getConnectionStr2, Destination:=Range("A3"), Sql:=sqlstring1)
.Refresh
End With
End Sub
----------------------------------
Private Function getConnectionStr2()
'DRIVER={SQL Server};
getConnectionStr2 = "ODBC;DRIVER={SQL Server};" & _
"DATABASE=em_Consumer;" & _
"SERVER=192.160.160.150;" & _
"UID=user;" & _
"PWD=server!;"
End Function
I'm new to VBA. Right now, I want to create editable crosstab table using temp table. I have problem when I want to update the normalize table based on edited data. When I run my codes, I get this error, Error 3061: Too Few Parameters.Expected 2.Can somebody help me to check my codes? Thanks in advance
Public Sub Normalize()
Dim rs As DAO.Recordset
On Error GoTo EH
'delete existing data from temp table
CurrentDb.Execute "DELETE * FROM tblNormalize;", dbFailOnError + dbSeeChanges
'get a recordset of the column headers
Set rs = CurrentDb.OpenRecordset("SELECT DISTINCT newvalue FROM Table1;")
Debug.Print
rs.MoveFirst
Do While rs.EOF = False
' "un" crosstab the data from crosstab table into Normalize table
CurrentDb.Execute "INSERT INTO tblNormalize (product, spec, descr,newvalue, Rate )" & Chr(10) & _
"SELECT product,spec,descr, " & rs.Fields("newvalue") & ", [" & rs.Fields("newvalue") & "]" & Chr(10) & _
"FROM tblCrosstab;", dbFailOnError + dbSeeChanges
Debug.Print rs.Fields("newvalue")
rs.MoveNext
Loop
rs.Close
Set rs = Nothing
'update the original normalized dataset
CurrentDb.Execute "UPDATE tblNormalize INNER JOIN Table1 t1 ON (tblNormalize.newvalue = t1.newvalue) " & _
" AND (tblNormalize.product = t1.product) AND (tblNormalize.spec = t1.spec) " & _
" AND (tblNormalize.descr = t1.descr)" & _
" SET Table1.Rate = tblNormalize.Rate;", dbFailOnError + dbSeeChanges
Exit Sub
EH:
MsgBox "Error " & Err.Number & ": " & Err.Description, vbOKOnly, "Error"
End Sub
You are creating a world of hurt for yourself. Apart from that, this:
"INSERT INTO tblNormalize (product, spec, descr,newvalue, Rate )" & Chr(10) & _
"SELECT product,spec,descr, " & rs.Fields("newvalue") & ", [" & rs.Fields("newvalue") & "]" & Chr(10) & _
"FROM tblCrosstab;"
Is going to come out all wrong.
Try:
"INSERT INTO tblNormalize (product, spec, descr,newvalue, Rate )" & _
" SELECT product,spec,descr, " & rs.Fields("newvalue") & ", [" _
& rs.Fields("newvalue") & "] FROM tblCrosstab;"
Also, use Debug.Print to write the string to the immediate window (Ctrl+G) and check if it works in the query design window. That error is usually due to misspelling of missing fields (columns).
In MS Access QBE if I paste the following SQL, it works correctly and I get 2 records back-
SELECT [tmp_binning].[bn_faibash] FROM [tmp_binning] WHERE key2='0210043-HOU-STOR' ORDER BY [tmp_binning].[bn_faibash];
But if I programmatically run the same query in VBA from an ADO object I get (incorrectly) no records. If I change the SQL to remove brackets around the field name, it does correctly return the 2 records in VBA ADO.
SELECT [tmp_binning].bn_faibash FROM [tmp_binning] WHERE key2='0210043-HOU-STOR' ORDER BY [tmp_binning].bn_faibash;
I've been unsuccessful googling to figure why this happens on my own, can anyone tell me why?
Thanks.
First, the brackets aren't required, either in the in Access UI or via ADO. Simply omit them in all environments and the problem should go away. (If it is the Access QBE thing that is adding the brackets then consider another tool or hand crafting your SQL code!)
Second, even with the brackets I can't reproduce the error using your SQL code e.g.
Sub gjskdjs()
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 tmp_binning" & vbCr & "(" & vbCr & " bn_faibash VARCHAR(255)," & _
" " & vbCr & " key2 VARCHAR(255)" & vbCr & ");"
.Execute Sql
Sql = _
"INSERT INTO tmp_binning (bn_faibash, key2)" & _
" VALUES ('002', '0210043-HOU-STOR');"
.Execute Sql
Sql = _
"INSERT INTO tmp_binning (bn_faibash, key2)" & _
" VALUES ('001', '0210043-HOU-STOR');"
.Execute Sql
Sql = _
"SELECT [tmp_binning].bn_faibash " & vbCr & " FROM" & _
" [tmp_binning] " & vbCr & " WHERE key2 = '0210043-HOU-STOR'" & _
" " & vbCr & " ORDER " & vbCr & " BY [tmp_binning].bn_faibash;"
Dim rs
Set rs = .Execute(Sql)
MsgBox rs.GetString
End With
Set .ActiveConnection = Nothing
End With
End Sub
Consider posting your schema as SQL DDL with sample data.