I'm trying to import data from a SQLight database to EXCEL with vba and here is my code :
Sub Importer_Contrat()
Dim conn As Object, rst As Object
Dim strSQL As String, table_name As String
Set conn = CreateObject("ADODB.Connection")
Set rst = CreateObject("ADODB.Recordset")
' OPEN CONNECTION
conn.Open "DRIVER=SQLite3 ODBC Driver;Database=" & Chemin_BDD & BDD2 & ";"
strSQL = "SELECT * FROM " & Contract_Table
' OPEN RECORDSET]
rst.Open strSQL, conn
' OUTPUT TO WORKSHEET
sh_test_sql.Range("test_paste").CopyFromRecordset rst
rst.Close
End Sub
My data data base has only 3 columns (chrono is Integer, Nom is Text and Date is Integer)
The vba works wells when I request an Integer but each time it is asked to import Data from the column Name which is Text and not Integer it doesn't work.
With the code above I just receive the first colum Chrono in Integer.
What is also very strange is that if i use this code :
strSQL = "SELECT * FROM " & Contract_Table
' OPEN RECORDSET]
rst.Open strSQL, conn
Do While Not rst.EOF
MsgBox rst(1)
rst.MoveNext
Loop
I can see the Text I want to import but it doesn't work with the recorset. Do you know where the problem is coming from ? I need to paste a big table on my Excel sheet and I've been looking the answer for days now.
Thank you in advance !
It seems that, while the data is present in the recordset, the CopyFromRecordset method fails to work. As I have used this method quite a lot against other data sources, I would assume that there is an issue with the ODBC driver.
There are many ways to read the data from a recordset. You can loop over it manually, or you can use the GetRows method to build a 2-dimensional array. This 2-dimensional array has the column as first index and the row as second, both dimensions are 0-based.
The following code uses this method and writes the data into a sheet - only that rows and columns are exchanged. I did a test with Worksheetfunction.Transpose to change this but got a runtime error Type mismatch.
Dim myData
myData = rst.GetRows
Dim r As Range
With ThisWorkbook.Sheets(1)
Set r = .Range(.Cells(1, 1), .Cells(UBound(x, 1) + 1, UBound(x, 2) + 1))
r.Value = x
End With
Thank you for your answer. I also think that there is an issue with the ODBC driver and the function CopyFromRecordset. I have solved my issue with a loop on each value of the sql database and an Array that I paste in my Excel :
ReDim Contract_Array(nb_row - 1, Nb_col_DB_Contracts - 1)
For row_runner = 0 To nb_row - 1
For col_runner = 0 To Nb_col_DB_Contracts - 1
Contract_Array(row_runner, col_runner) = rst(col_runner)
Next col_runner
rst.MoveNext
Next row_runner
sh_test_sql.Range("A1:G2").Value = Contract_Array
Thank you for your help !
Related
I am using VBA to output information into an Excel worksheet that has been gathered from a SQL Server database called "PHB". I can connect to the database and pull information by calling a view.
When I dump the data into my Excel worksheet the column headings of the database data are included and I don't want that. I have to use an offset to get the data to look right. I can manipulate the results worksheet and remove the columns with VBA. If there is some switch I can use on either (VBA or T-SQL) end it seems like it would be a much cleaner and simpler approach.
Here are the relevant parts of my logic:
Public Sub Show_ProductCode()
Dim PHB_cnn As New ADODB.Connection
Dim ProductCode_qry As String
Dim ProductCode_rst As New ADODB.Recordset
Dim ProductCode_qtbl As QueryTable
Dim ProductCode As String
Dim OffsetAmt As String
Dim OffsetAmt_int As Integer
PHB_cnn.Provider = "sqloledb"
PHB_cnn.CursorLocation = adUseClient
PHB_cnn.Open p_PHB_Connect_s 'In Module
.
.
.
For Each c In DataRange_rng
ProductCode = c.Value
ProductCode_qry = "SELECT * FROM vw_ShowPurchaseHistory WHERE ProductCode = '" & ProductCode & "'"
ProductCode_rst.Open ProductCode_qry, PHB_cnn, adOpenStatic, adLockOptimistic
With ProductCode_rst
OffsetAmt = .RecordCount
If ProductCode_rst.EOF Then
Debug.Print "No Records"
Else
OffsetAmt_int = OffsetAmt_int + (CInt(OffsetAmt) * 2)
With Worksheets("Results")
Set ProductCodes_qtbl = .QueryTables.Add(ProductCode_rst, .Range("A" & OffsetAmt_int))
ProductCodes_qtbl.Refresh
End With
End If
End With
If ProductCode_rst.State = adStateOpen Then ProductCode_rst.Close
Set ProductCode_rst = Nothing
Set ProductCode_qtbl = Nothing
Next c
exit_Show_ProductCode:
If ProductCode_rst.State = adStateOpen Then ProductCode_rst.Close
Set ProductCode_rst = Nothing
Set ProductCode_qtbl = Nothing
Exit Sub
err_Show_ProductCode:
MsgBox Err.Description, vbOKOnly
Resume exit_Show_ProductCode
End Sub
My input data:
My output:
your code is going to be very inefficient as it is executing a SQL statement for each ProductCode. It would be better to loop through these values and build up a SQL IN statement and then, after the loop, execute it once e.g.
...
ProductCode_in = "('productcode1', 'productcode2','productcode3',...., 'productcode_n')"
ProductCode_qry = "SELECT * FROM vw_ShowPurchaseHistory WHERE ProductCode IN '" & ProductCode_in
...
You'll then end up with all your data in Excel with a single header row - which is simple to delete with a VBA statement (sheet.row(1).delete).
I have some VBA code to pull out data from a workbook with VBA, and it works.
I can specify the input range, and get the data in.
This is important for me because i need to be able to open a workbook fast (normal opening is 3+ minutes, ADODB is 12 seconds...)
Also it is important for me since i want to just get the data for myself, while other users are working on it (and here comes some problem in)
In addition to this code, it needs to be able to do the following
I need to be able to specify where the data will go (destination worksheet, and row and column)
I need to be able to execute this macro, without interfering other users:
If i run the macro in it's current form, When another user has the workbook open, i pull data from it, the other user is not able to save anymore, any suggestions?
Also: Sometimes when another user has the workbook open, I am not able to pull data from it.
Anybody can help me out with being able to open this with ADODB and other users can still save, and helping me with being able to specify the destination range in the sub?
(so i can specify where the data will land ? :) )
Many thanks!
(Below all Code)
This sub is an example sub, of how to pull out the data
Sub test()
file_path = "C:\"
file_name = "Example.xlsx"
Call Pull_Data_from_Excel_with_ADODB(CStr(file_path & file_name), "The Worksheet", 1, 1, 600, 25)
End Sub
The sub that pulls data from an excel file with ADODB
Sub Pull_Data_from_Excel_with_ADODB(filename As String, sheetname As String, _
startRow As Integer, StartColumn As Integer, _
endRow As Integer, EndColumn As Integer)
'-----------------------------------------------------------------------------------
'I ********references are set to:********
'I * Visual Basic For Applications
'I * Microsoft Excel 12.0 ObjectLibrary
'I * Microsoft ADO Ext. 6.0 for DDL and Security
'I * Microsoft ActiveX Data Objects 6.1 Library
'I * Microsoft AcitveX Data Objects Recordset 6.0 Library
'-----------------------------------------------------------------------------------
On Error Resume Next
Dim cnStr As String
Dim rs As ADODB.Recordset
Dim query As String
Application.ScreenUpdating = False
my_range = CellRange_to_nameRange(startRow, StartColumn, endRow, EndColumn)
sheetrange = my_range
'Dim filename As String
'filename = "C:\temp\file1.xlsm"
cnStr = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & filename & ";" & _
"Extended Properties=Excel 12.0"
'query = "SELECT * FROM [Sheet1$D1:D15]"
query = "SELECT * FROM [" & sheetname & "$" & sheetrange & "]"
Set rs = New ADODB.Recordset
rs.Open query, cnStr, adOpenStatic, adLockReadOnly
'------------------------------------------------------------------------'------------------------------------------------------------------------
' Ways of opening the data & their explaination - CursorTypeEnum Values
'------------------------------------------------------------------------'------------------------------------------------------------------------
' Constant - Value - Description
'------------------------------------------------------------------------'------------------------------------------------------------------------
' adOpenUnspecified - -1 - Unspecified type of cursor
' adOpenForwardOnly - 0 - Default. A forward-only cursor. This improves performance when you need to make only one pass through a Recordset
' adOpenKeyset - 1 - A keyset cursor. Like a dynamic cursor, except that you can't see records that other users add, although records that other users delete are inaccessible from your Recordset. Data changes by other users are still visible.
' adOpenDynamic - 2 - A dynamic cursor. Additions, changes, and deletions by other users are visible, and all types of movement through the Recordset are allowed
' adOpenStatic - 3 - A static cursor. A static copy of a set of records that you can use to find data or generate reports. Additions, changes, or deletions by other users are not visible.
'------------------------------------------------------------------------'------------------------------------------------------------------------
'------------------------------------------------------------------------'------------------------------------------------------------------------
' Lock Types & their explaination - LockTypeEnum Values
'------------------------------------------------------------------------'------------------------------------------------------------------------
' Constant - Value - Description
'------------------------------------------------------------------------'------------------------------------------------------------------------
' adLockUnspecified - -1 - Unspecified type of lock. Clones inherits lock type from the original Recordset.
' adLockReadOnly - 1 - Read-only records
' adLockPessimistic - 2 - Pessimistic locking, record by record. The provider lock records immediately after editing
' adLockOptimistic - 3 - Optimistic locking, record by record. The provider lock records only when calling update
' adLockBatchOptimistic - 4 - Optimistic batch updates. Required for batch update mode
'------------------------------------------------------------------------'------------------------------------------------------------------------
'------------------------------------------------------------------------'------------------------------------------------------------------------
' ????????? - CommandTypeEnum Values
'------------------------------------------------------------------------'------------------------------------------------------------------------
' Constant - Value - Description
'------------------------------------------------------------------------'------------------------------------------------------------------------
' Constant - Value - Description
' adCmdUnspecified - -1 - Unspecified type of command
' adCmdText - 1 - Evaluates CommandText as a textual definition of a command or stored procedure call
' adCmdTable - 2 - Evaluates CommandText as a table name whose columns are returned by an SQL query
' adCmdStoredProc - 4 - Evaluates CommandText as a stored procedure name
' adCmdUnknown - 8 - Default. Unknown type of command
' adCmdFile - 256 - Evaluates CommandText as the file name of a persistently stored Recordset. Used with Recordset.Open or Requery only.
'------------------------------------------------------------------------'------------------------------------------------------------------------
'------------------------------------------------------------------------'------------------------------------------------------------------------
' Some Extra Options, i guess - ExecuteOptionEnum Values
'------------------------------------------------------------------------'------------------------------------------------------------------------
' Constant - Value - Description
'------------------------------------------------------------------------'------------------------------------------------------------------------
' adOptionUnspecified - -1 - Unspecified command
' adAsyncExecute - 16 - The command should execute asynchronously. Cannot be combined with the CommandTypeEnum value adCmdTableDirect
' adAsyncFetch - 32 - The remaining rows after the initial quantity specified in the CacheSize property should be retrieved asynchronously
' adAsyncFetchNonBlocking - 64 - The main thread never blocks while retrieving. If the requested row has not been retrieved, the current row automatically moves to the end of the file. If you open a Recordset from a Stream containing a persistently stored Recordset, adAsyncFetchNonBlocking will not have an effect; the operation will be synchronous and blocking. adAsynchFetchNonBlocking has no effect when the adCmdTableDirect option is used to open the Recordset
' adExecuteNoRecords - 128 - The command text is a command or stored procedure that does not return rows. If any rows are retrieved, they are discarded and not returned. adExecuteNoRecords can only be passed as an optional parameter to the Command or Connection Execute method
' adExecuteStream - 256 - The results of a command execution should be returned as a stream. adExecuteStream can only be passed as an optional parameter to the Command Execute method
' adExecuteRecord - 512 - The CommandText is a command or stored procedure that returns a single row which should be returned as a Record object
'------------------------------------------------------------------------'------------------------------------------------------------------------
Cells.Clear
Range("A3").CopyFromRecordset rs
Dim cell As Range, i As Long
'headers
With Range("A1").CurrentRegion
For i = 0 To rs.Fields.Count - 1
.Cells(2, i + 1).Value = rs.Fields(i).Name
Next i
.EntireColumn.AutoFit
End With
rs.Close
'Unload rs
Application.ScreenUpdating = True
End Sub
Function below converts e.g. 1,1,2,2 to "A1:B2"
Public Function CellRange_to_nameRange(startRow As Integer, StartColumn As Integer, endRow As Integer, EndColumn As Integer)
Dim exportstring As String
exportstring = CStr(RowAndCollumnToName(startRow, StartColumn)) + ":" + CStr(RowAndCollumnToName(endRow, EndColumn))
CellRange_to_nameRange = exportstring
End Function
Function below converts e.g.: 1,1, to "A1"
Public Function RowAndCollumnToName(row_number As Integer, column_number As Integer)
Dim constr As String
constr = CStr(ColumnNumber_to_ColumnName(CInt(column_number)))
constr = constr & CStr(row_number)
RowAndCollumnToName = constr
End Function
Function below takes in any number from 1 to 26, an spits out the matching letter from the alphabet: e.g. 3 --> C
Public Function number_to_alphabet_letter(number As Integer)
Dim MyArray(1 To 26) As String
For intLoop = 1 To 26
MyArray(intLoop) = Chr$(64 + intLoop)
Next
number_to_alphabet_letter = MyArray(number)
End Function
And function below converts the ColumnNumber to the name (up to 3 digits...)
Public Function ColumnNumber_to_ColumnName(number As Integer)
On Error Resume Next
Dim first_digit As Integer
Dim first_letter As String
first_digit = number Mod 26
first_letter = number_to_alphabet_letter(first_digit)
'-----------------------------------------------------------
Dim second_digit As Integer
Dim second_letter As String
second_digit = (((number - (number Mod 26)) / 26) Mod 26)
second_letter = number_to_alphabet_letter(second_digit)
'-----------------------------------------------------------
Dim third_digit As Integer
Dim third_letter As String
third_digit = number - ((((number Mod 26) + ((((number - (number Mod 26)) / 26) Mod 26) * 26))))
third_digit = third_digit / (26 * 26)
third_letter = number_to_alphabet_letter(third_digit)
'-----------------------------------------------------------
'number_to_alphabet_letter_advanced = CStr(third_digit) + "-" + CStr(second_digit) + "-" + CStr(first_digit) 'test
ColumnNumber_to_ColumnName = third_letter + second_letter + first_letter
End Function
update
i get eitherway or the error message "Run-time error '-2147467259 (90004005)': Unexpected error from external database driver ()." or the person that uses the excel sheet gets the error message "can't save" when trying to save
Not an answer, but too large to fit in a comment....
Those last four methods called by this:
my_range = CellRange_to_nameRange(startRow, StartColumn, endRow, EndColumn)
can be removed if you instead use something like:
With ActiveSheet
my_range = .Range(.Cells(startRow, StartColumn), _
.Cells(endRow, EndColumn)).Address()
End With
I am importing data into Excel from a SQL Server 2012 database. The issue I have is that SQL Server 2012 Date datatype columns are not being recognised consistently in Excel.
If I use ADO Recordsets to import data from specific columns, data with column datatype Date or Datetime is copied into the Recordset as VBA datatype String (instead of Date or Integer).
Reproducing the Recordset in Excel yields strings in the format yyyy-mm-dd. These cells are not recognized by Excel as date/time, even if I change the formatting.
Yet when I refer to the Excel cell from another cell the Date type is recognized (eg: A1 contains the result of my SQL VBA Recordset query, for example "2013-04-17". I enter into cell A2 "=A1 + 1", A2 will display it as 41382.
However, when I use MS Query to extract data from the same Database using ListObjects and ODBC, the same data from the same database is returned with dates being interpreted correctly by Excel (ie I import a column called "Transaction Date" with SQL datatype Datetime via MS Query the result will be a MS Excel Date "Integer").
How do I amend my VBA Recordset code to treat data in the format yyyy-mm-dd as dates instead of strings?
Thanks,
John
PS: SQL queries I execute vary so that sometimes I get data from columns with datatype "date" and sometimes its just integers or Double datatype. This means that hardcording "Convert(INT, TransactionDate)" into the SELECT statement is not really possible. However, I am a total amateur at SQL so there might be a super easy solution to this (eg if I ever access columns with datatype "DateTime" then SQL should always send "CONVERT(DBL, XXX)" instead of XXX where XXX is a column with datatype DATE.
Function GetSQL(strQuery As String) As Variant
Dim rst As ADODB.Recordset
Dim element As Variant
Dim i, j As Integer
Dim v As Variant
On Error GoTo aError
Call ConnecttoDB
cnt.Open
Set rst = New ADODB.Recordset
rst.Open strQuery, cnt, adOpenStatic
rst.MoveFirst
If rst.RecordCount = 0 Then 'i.e. if it's empty
v = CVErr(xlErrNA)
rst.Close
cnt.Close
Else
End If
v = rst.GetRows
For i = 0 To UBound(v, 1)
For j = 0 To UBound(v, 2)
If v(i, j) = -9999 Then
v(i, j) = CVErr(xlErrNA)
Else
End If
Next j
Next i
GetSQL = Application.WorksheetFunction.Transpose(v)
rst.Close
cnt.Close
Exit Function
aError:
MsgBox Err.Description
rst.Close
cnt.Close
End Function
The issue arose from using the Excel function Transpose instead of looping through the contents of the Recordset results object.
In the process of Transposing via Excel some information included in the Recordset (such as for eample Datatype) seems to get lost. This results in dates being interpreted as strings by Excel.
Instead of using the Excel Transpose function I guess youre meant to use a loop, as that avoids the loss of information described above.
The type of field in ado recodset can't be changed but have you tried UDT? Here a short sample with user defined type which will wrap the ado recordset. Then in your code you will use your own recordset which will use Date data type.
Add reference to Microsoft ActiveX Data Objects Library.
Standard module vba code:
Private Const CONNECTION_STRING As String = "Provider=sqloledb;Data Source=SQLSERVER2012;Initial Catalog=Test;Integrated Security=SSPI;"
Private Const SQL_QUERY As String = "select * from dbo.DateTest"
Public Type MyRecord
Id As Long
CreatedAt As Date
End Type
Public Sub test()
Dim myRecodset() As MyRecord
myRecodset = GetSQL
End Sub
Public Function GetSQL() As MyRecord()
On Error GoTo aError
Dim adodbConnection As ADODB.Connection
Set adodbConnection = New ADODB.Connection
With adodbConnection
.ConnectionString = CONNECTION_STRING
.CursorLocation = adUseServer
.Open
End With
Dim newRecordset() As MyRecord
Dim newRecord As MyRecord
Dim rowIndex As Long
Dim adodbRecordset As ADODB.Recordset
Set adodbRecordset = New ADODB.Recordset
With adodbRecordset
.Open SQL_QUERY, adodbConnection, adOpenStatic
.MoveFirst
ReDim newRecordset(.RecordCount - 1)
Do While Not .EOF
newRecord.Id = .Fields("Id")
newRecord.CreatedAt = .Fields("CreatedAt")
newRecordset(rowIndex) = newRecord
rowIndex = rowIndex + 1
.MoveNext
Loop
End With
GetSQL = newRecordset
aError:
If (Err.Number <> 0) Then MsgBox Err.Description
adodbRecordset.Close
adodbConnection.Close
End Function
Tested with this table:
CREATE TABLE [dbo].[DateTest]
(
[Id] [int] IDENTITY(1,1) NOT NULL,
[CreatedAt] [date] NOT NULL
)
Good day,
I have been having a problem with a bit of simple VBA. I wrote a script to take a text query (with no input parameters so no real user interaction, SQL Injection, etc.), run it against a database, and dump it to a new worksheet. This is a simple one-off for some developer analysis so the features are extremely simple.
If the query returns values for every column, there is no problem. However, if the query has any null values in it (as the result of a ROLLUP(), in my case), the entire subroutine will fail at MoveNext (NOTE: not the assignment of the null value to a cell). Originally, the script was failing before the null row was ever even accessed at
Range(Cells(2, 1), Cells(rsData.RecordCount + 1, rsData.Fields.Count)).NumberFormat = "#"
This was commented and moved to be cell-by-cell with the intent of adding a check if the current cell is null (by far the most common suggestion on the internet).
The queries have been verified using a back-end SQL editor and are correct. Every other article that I have read has either been specific to a product or not applicable. The question, then, is simply: how is one supposed to handle null values in a Recordset? I would like to avoid removing the nulls on the database side, as this sub is used for many different queries and the thought of having to pepper my queries with a bunch of NVL() statements is quite displeasing.
Thank you in advance for any assistance. Full code is as follows:
Sub runReport(query As String, sheetName As String)
Dim cnDatabase As ADODB.Connection
Dim rsData As ADODB.Recordset
Dim row As Integer
Dim column As Integer
'Create new worksheet
Sheets.Add.Name = sheetName
Excel.Application.Worksheets(sheetName).Select
'Connect to database
Set cnDatabase = New Connection
cnDatabase.ConnectionString = "Provider=OraOLEDB.Oracle;Data Source=DB.EXAMPLE.COM;User ID=FOO;Password=BAR;ChunkSize=1000;FetchSize=100;"
cnDatabase.Open
'Retrieve dataset
Set rsData = New Recordset
Set rsData.ActiveConnection = cnDatabase
rsData.Source = query
rsData.CursorLocation = adUseClient
rsData.CursorType = adOpenStatic
rsData.Open
'Output header row
For column = 1 To rsData.Fields.Count
Cells(1, column).Value = rsData.Fields(column - 1).Name
Rows(1).Font.Bold = True
Next
'Set all fields as text
'Range(Cells(2, 1), Cells(rsData.RecordCount + 1, rsData.Fields.Count)).NumberFormat = "#"
'Output retrieved data from database
row = 2
While Not rsData.EOF
For column = 1 To rsData.Fields.Count
Cells(row, column).NumberFormat = "#"
Cells(row, column).Value = rsData.Fields(column - 1).Value
Next
rsData.MoveNext
row = row + 1
Wend
cnDatabase.Close
End Sub
Try altering:
rsData.CursorLocation = adUseClient
to:
rsData.CursorLocation = adUseServer
(based on this archived Microsoft support article on a different Oracle issue)
Can you please let me know if it is possible to list all fields name in a MS Access table?
I work in ms access far too much.
The only way I know of to do this, would be using vba, and defining for example a recordset, and looping through the fields.
Eg:
Sub ListFields()
dim rst as new adodb.recordset
rst.open "SELECT * FROM SomeTable", CurrentProject.Connection, adOpenForwardOnly, adLockReadOnly
' Note: adOpenForwardOnly and adLockReadOnly are the default values '
' for the CursorType and LockType arguments, so they are optional here '
' and are shown only for completeness '
dim ii as integer
dim ss as string
for ii = 0 to rst.fields.count - 1
ss = ss & "," & rst.fields(ii).name
next ii
Debug.Print ss
End Sub
The string variable ss will contain a comma-delimited list of all the column names in the table named "SomeTable".
With a little reformatting of the logic you should be able to insert this data into another table if you wanted to, then query it out.
Does this help?
This version is easy to run and will paste right into Access. Add this function to a module, run with F5, and copy the result from the inputbox:
Public Function FieldNames() As String
Dim sTable As String
Dim rs As DAO.Recordset
Dim n As Long
Dim sResult As String
sTable = InputBox("Name of table?")
If sTable = "" Then
Exit Function
End If
Set rs = CurrentDb.OpenRecordset(sTable)
With rs
For n = 0 To .Fields.Count - 1
sResult = sResult & .Fields(n).Name & vbCrLf
Next 'n
.Close
End With
Set rs = Nothing
InputBox "Result:" & vbCrLf & vbCrLf _
& "Copy this text (it looks jumbled, but it has one field on each line)", _
"FieldNames()", sResult
End Function
Alternative Output:
User user1003916 supplied an alternative to the InputBox to overcome the 1024 character limit (I have not tested this yet):
Sub CopyText(Text As String)
'VBA Macro using late binding to copy text to clipboard.
'By Justin Kay, 8/15/2014
Dim MSForms_DataObject As Object
Set MSForms_DataObject = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
MSForms_DataObject.SetText Text
MSForms_DataObject.PutInClipboard
Set MSForms_DataObject = Nothing
End Sub
UPDATE: TO USE THIS SQL QUERY YOU MUST USE A TOOL SUCH AS DBEAVER.
ACCESS CLIENT WILL NOT ALLOW YOU TO QUERY IT'S HIDDEN STRUCTURES.
YIKES! IMO: I can't imagine wanting to dive into the dark underbelly of VBA
How to get Access Table Columns by SQL
SELECT * FROM information_schema.columns
WHERE TABLE_NAME="YOUR_TABLE_NAME"
AND
TABLE_SCHEMA="PUBLIC"
PS I noticed Access called my Schema "PUBLIC"
Above used an Access 2016 and was tested over ODBC and jdbc:ucanaccess and works like a charm.
Example output
You can simply use the Documenter tool. Go to Database Tools > Database Documenter, select the table and press OK.
This SQL works in Access 2016 for Queries, not Tables, but might be useful.
SELECT MSysObjects.Name AS QueryName,
IIf(IsNull([Name1]),
Right([Expression],Len([Expression])-InStr(1,[Expression],".")),[name1])
AS FieldName
FROM MSysQueries INNER JOIN MSysObjects
ON MSysQueries.ObjectId = MSysObjects.Id
WHERE MSysQueries.Attribute=6;
A quick and dirty method involves Excel. Do the following:
Open the table in Datasheet view.
Export to an Excel file, using the particular procedure for your Access version.
Open Excel file (if not already open).
Select and copy the first row containing the headers.
Add another sheet to the workbook (if none exist).
Click A1.
Paste Special > Transpose
The Fields will be pasted in a single column. To find out their Field Index number, in Cell B1 type "0", then series fill down to the last row of the field numbers.
In addition, you can sort the column alphabetically, especially for legacy flat files involving dozens of fields. This really saves a lot of time when I'm trying to convert a flatfile to a relational model.
There are already some good answers but I decided to add my own twist. Hopefully, they are self-explanatory.
Usage:
getFieldNames(TableName:="Table1",IncludeBrackets:=True,Delimiter:=vbNewLine,CopyToClipboard:=True)
getFieldNames(TableName:="Table1",IncludeBrackets:=True,CopyToClipboard:=True)
getFieldNames(TableName:="Table1",IncludeBrackets:=True)
getFieldNames(TableName:="Table1")
I use this to build an array of field names:
Chr(34) & getFieldNames(TableName:="Table1",IncludeBrackets:=False, Delimiter:= Chr(34) & "," & Chr(34)) & Chr(34)
Function getFieldNames(ByVal TableName As String, Optional ByVal IncludeBrackets As Boolean, Optional ByVal Delimiter As String = ", ", Optional ByVal CopyToClipboard As Boolean) As String
Dim rs As DAO.Recordset
On Error Resume Next
Set rs = CurrentDb.OpenRecordset(TableName)
On Error GoTo 0
If rs Is Nothing Then Exit Function
Dim results() As String
ReDim results(rs.Fields.Count - 1)
Dim n As Long
For n = 0 To rs.Fields.Count - 1
results(n) = rs.Fields(n).Name
Next
rs.Close
Dim result As String
If IncludeBrackets Then
result = "[" & Join(results, "]" & Delimiter & "[") & "]"
Else
result = Join(results, Delimiter)
End If
If CopyToClipboard Then
With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
.SetText result
.PutInClipboard
End With
End If
getFieldNames = result
End Function
This is not SQL, but this question is the top Google result for someone like me who just needs to list out the field names needed for a query to select since Access does not support "* except foo, bar" for getting 99% of a table.
Answer adapted from a social.msdn.com answer by Patrick Wood, Access MVP
https://social.msdn.microsoft.com/Forums/office/en-US/1fe5546b-db3f-4e17-9bf8-04f4dee233b7/how-to-list-all-the-field-names-in-a-specified-table?forum=accessdev
Change tablename to your name in the module. This Function should be at the global level:
Function ListTdfFields()
' NOT doing DIMs, since then you must enable/attach ADODB or DAO
' Dim db As ADO.Database
Set db = CurrentDb
tablename = "tblProductLicense" ' <=== YOUR TABLE NAME HERE
Set tdf = db.TableDefs(tablename)
For Each fld In tdf.Fields
Debug.Print tablename; ".["; fld.Name; "]," ;
' remove ending ; for 1 line per field
Next
Debug.Print ""
Set tdf = Nothing
Set db = Nothing
End Function
Then add a macro RunCode ListTdfFields() and run it. Output will be sent to the Immediate window of the VBA design view for the module.
I would like to share this VBA solution, which I did not write, only slightly modified (changed the tableName to use 'SourceTable'). Once it is run you can query the table it creates. It takes advantage of hidden system tables.
Sub GetField2Description()
'************************************************* *********
'Purpose: 1) Deletes and recreates a table (tblFields)
' 2) Queries table MSysObjects to return names of
' all tables in the database
' 3) Populates tblFields
'Coded by: raskew
'Inputs: From debug window:
' Call GetField2Description
'Output: See tblFields
'************************************************* *********
Dim db As DAO.Database, td As TableDef
Dim rs As Recordset, rs2 As Recordset
Dim Test As String, NameHold As String
Dim typehold As String, SizeHold As String
Dim fielddescription As String, tName As String
Dim n As Long, i As Long
Dim fld As Field, strSQL As String
n = 0
Set db = CurrentDb
' Trap for any errors.
On Error Resume Next
tName = "tblFields"
'Does table "tblFields" exist? If true, delete it;
DoCmd.SetWarnings False
DoCmd.DeleteObject acTable, "tblFields"
DoCmd.SetWarnings True
'End If
'Create new tblTable
db.Execute "CREATE TABLE tblFields(Object TEXT (55), FieldName TEXT (55), FieldType TEXT (20), FieldSize Long, FieldAttributes Long, FldDescription TEXT (20));"
strSQL = "SELECT MSysObjects.Name, MSysObjects.Type From MsysObjects WHERE"
strSQL = strSQL + "((MSysObjects.Type)=1)"
strSQL = strSQL + "ORDER BY MSysObjects.Name;"
Set rs = db.OpenRecordset(strSQL)
If Not rs.BOF Then
' Get number of records in recordset
rs.MoveLast
n = rs.RecordCount
rs.MoveFirst
End If
Set rs2 = db.OpenRecordset("tblFields")
For i = 0 To n - 1
fielddescription = " "
Set td = db.TableDefs(i)
'Skip over any MSys objects
If Left(rs!Name, 4) <> "MSys" And Left(rs!Name, 1) <> "~" Then
NameHold = rs!Name
On Error Resume Next
For Each fld In td.Fields
tableName = fld.SourceTable
fielddescription = fld.Name
typehold = FieldType(fld.Type)
SizeHold = fld.Size
rs2.AddNew
rs2!Object = tableName
rs2!FieldName = fielddescription
rs2!FieldType = typehold
rs2!FieldSize = SizeHold
rs2!FieldAttributes = fld.Attributes
rs2!FldDescription = fld.Properties("description")
rs2.Update
Next fld
Resume Next
End If
rs.MoveNext
Next i
rs.Close
rs2.Close
db.Close
End Sub
Function FieldType(intType As Integer) As String
Select Case intType
Case dbBoolean
FieldType = "dbBoolean" '1
Case dbByte
FieldType = "dbByte" '2
Case dbInteger
FieldType = "dbInteger" '3
Case dbLong
FieldType = "dbLong" '4
Case dbCurrency
FieldType = "dbCurrency" '5
Case dbSingle
FieldType = "dbSingle" '6
Case dbDouble
FieldType = "dbDouble" '7
Case dbDate
FieldType = "dbDate" '8
Case dbBinary
FieldType = "dbBinary" '9
Case dbText
FieldType = "dbText" '10
Case dbLongBinary
FieldType = "dbLongBinary" '11
Case dbMemo
FieldType = "dbMemo" '12
Case dbGUID
FieldType = "dbGUID" '15
End Select
End Function
Build query:
SELECT Table_Name.*
FROM Table_Name
WHERE False;
Export to Excel
You will have each field name in one row without any data. If you select the row and copy, you can paste special>transpose and have them all in a single column.
I came here searching for the same requirement and after refering to this thread, drafted below code for my requirement. The Field names form the source table will be added to an array and later the Field names are assigned to the second table. Just sharing it here, this migh help someone later..
Public Sub FieldName_Change()
Dim intNumberOfFields, intX As Integer
Dim txtTableName,txttmpTableName txtFieldName() As String
intNumberOfFields = GetFieldNames(txtTableName, txtFieldName())
For intX = 1 To intNumberOfFields
CurrentDb.TableDefs(txttmpTableName).Fields("F" & intX).Name = txtFieldName(intX)
Next intX
End Sub
Public Function GetFieldNames(ByVal txtTableName As String, ByRef txtFiledName() As String) As Integer
Dim rs As DAO.Recordset
Dim n As Long
Dim sResult As String
Set rs = CurrentDb.OpenRecordset(txtTableName)
ReDim txtFiledName(rs.Fields.Count)
With rs
For n = 0 To .Fields.Count - 1
txtFiledName(n + 1) = .Fields(n).Name
Next n
.Close
GetFieldNames = n
End With
Set rs = Nothing
End Function
Not sure why no-one came up with the following, I had the same issue and none of the above answers either worked or were suitable (No VB,thank you).
This is simple Java (error checking etc omitted)
String query="SELECT TOP 1 * FROM mytable";
ResultSet rs=connectionSQL.createStatement().executeQuery(query);
ResultSetMetaData rsm=rs.getMetaData();
int colcount=rsm.getColumnCount();
for(int f=1; f<=colcount; f++) {
String coltype=rsm.getColumnTypeName(f);
String colname=rsm.getColumnName(f);
.... (whatever)
}
So there's your columNames and the data types.
Works like a charm in MSACCESS
Seems like this task was easier in older days. Likely this answer is highly version-dependent. It works for me in a quick test against an Access 2007 DB:
select
Specs.SpecName AS TableName,
Columns.FieldName
from
MSysIMEXColumns Columns
inner join MSysIMEXSpecs Specs on Specs.SpecID = Columns.SpecID
order by
Specs.SpecName,
Columns.FieldName
Give this a go...
private void Button_OldDDLDump_Click(object sender, EventArgs e)
{
string _cnstr = "connectionstringhere";
OleDbConnection _cn = new OleDbConnection(_cnstr);
try
{
_cn.Open();
System.Data.DataTable _dt = null;
try
{
_dt = _cn.GetSchema("tables");
m_msghelper.AppendArray( DataTableHelper.DataTableToString(_dt) );
}
catch (Exception _ex)
{
System.Diagnostics.Debug.WriteLine(_ex.ToString());
}
finally
{
_dt.Dispose();
}
}
catch (Exception _ex)
{
System.Diagnostics.Debug.WriteLine(_ex.ToString());
}
finally
{
_cn.Close();
}
}
Helper method to dump the database structure to a string array here..
public static class DataTableHelper
{
public static string[] DataTableToString( System.Data.DataTable dt )
{
List<string> _retval = new List<string>();
foreach (System.Data.DataRow row in dt.Rows)
{
foreach (System.Data.DataColumn col in dt.Columns)
{
_retval.Add( string.Format("{0} = {1}", col.ColumnName, row[col]) );
}
_retval.Add( "============================");
}
return _retval.ToArray();
}
}
select column_name from information_schema.columns where table_name='table'