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).
Hi all i have this situation in VB for Access.
GenraReport_Click() is the main function called when pressed a botton in the report.
Temp is a table containing some data like this:
Now i created a recordset rs to loop each record of Temp , by the field Item.
And it works , the problem is when i call the function prices that has to do exactley the same thing but on the field price.
The problem comes when i try to call rs!price (or rs![price] i tried both), it tells me that there are no records. I put a movefirst call at the end of the first loop to start again with the new function.
(i tried to do the main loop with price instead of item and it works so it's not the table and not the syntax the problem. What can it be?
Your Do Until loop is likely exceeding the number of records available in recordset, so compiler errors out at 'No Current Record'. Usually, the proper way to loop through a recordset is to set the iteration limit to the Recordset EOF property:
Dim rs As Recordset
Dim s As String, i As Integer
Set rs = CurrentDb.OpenRecordset("temp")
rs.MoveLast
rs.MoveFirst
s = "": i = 1
If rs.RecordCount > 0 Then
Do While Not rs.EOF ' OR Do Until rs.EOF
Select Case i
Case 1
s = CStr(rs!Price)
Case Is < rs.RecordCount
s = s & ", " & CStr(rs!Price)
Case Else
s = s & ", and " & CStr(rs!Price)
End Select
i = i + 1
rs.MoveNext
Loop
End if
rs.close
Set rs = Nothing
I have an Access Database with a table [tblManipulate] with the following four fields populated with data:
[tblManipulate].[Name]
[tblManipulate].[Description]
[tblManipulate].[Price]
[tblManipulate].[Account code]
I also have an 150 entry table of descriptions called [tblDescLookup] that needs to be utilized like a lookup table in order to manipulate account codes. Example entries follow:
[tblDescLookup].[Description Lookup] [tblDescLookup].[Account Code Result]
*demonstration* 10000
*coding* 12000
*e-mail* 13000
What is the best way to take every record in [tblManipulate] and check the [tblManipulate].[Description] field against [tblDescLookup].[Description Lookup], assigning the account code result into the original table if a 'like' match is found?
This seems to me like one of those instances where Access is not the best tool for the job, but it is what I have been instructed to use. I would appreciate any help or insight (or alternatives!). Thank you!
Something like this should do it for you.
Dim Description As String
Dim lookupDescription As String
Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset(SELECT * FROM tblManipulate)
If Not (rs.EOF And rs.BOF) Then
rs.MoveFirst 'good habit
Do Until rs.EOF = True
Description = rs("Description")
Dim rsLookUp As DAO.Recordset
Set rsLookUp = CurrentDb.OpenRecordset(SELECT * FROM tblDescLookup)
If Not (rsLookUp .EOF And rsLookUp .BOF) Then
rsLookUp .MoveFirst 'good habit
Do Until rsLookUp.EOF = True
lookupDescription = rsLookUp("Description Lookup")
If() Then 'match criteria
'assign value
End if
rsLookUp.MoveNext
Loop
Else
MsgBox "No records in the recordset."
End If
rs.MoveNext
Loop
Else
MsgBox "No records in the recordset."
End If
Oy. You're going to need a loop here. I would open up tblDescLookup in a recordset:
Set rec = CurrentDB.OpenRecordset ("Select * from tblDescLookup")
Then loop through each record and run the query that way:
Do While rec.EOF = False
Set rec2 = CurrentDB.OpenRecordset ("Select * from rec where Description like '" & rec("Description Lookup") & "'")
rec.MoveNext
Loop
Or maybe you need to make that an Update statement instead? I can't write that off the top of my head, but you get the idea.
Have you tried something like this?
Update tblManipulate as t1
Set [Account Code] = (Select [Account Code Result] from [tblDescLookup] where [Description Lookup] = t1.[Description])
I have a ADOBE.Recordset in Excel VBA returned from a query to database. How should I find a certain record in this set that fits certain criteria? Below is the code. Could anyone fill in the " 'print out the name of one person whose age is i" part for me? Thanks in advance!
Dim rs As ADOBE.Recordset
q = "select name, age from people where country = 'US'"
Set rs = conn.Execute(q) 'conn is an ADOBE.Connection
For i = 30 To 40
'print out the name of one person whose age is i
Next i
Update 1:
Thanks KazJaw! I think your solutions should work. However, I am looking for a cleaner solution -
I don't want to save the query results into a sheet. I'd prefer them in memeory.
Is there a .Find or .Search function I can use so that I don't need to implement the search with a loop (as you did in the Second Solution)?
Maybe I am being greedy here, but ideally, I'd like something like this:
Dim rs As ADOBE.Recordset
q = "select name, age from people where country = 'US'"
Set rs = conn.Execute(q) 'conn is an ADOBE.Connection
For i = 30 To 40
name = rs.Find("age = i")!name 'this line is where I am not sure how to achieve
MsgBox name & "'s age is " & i
Next i
Apologies for the formatting. I am new to the site, not sure how to properly indent the two lines in the For loop.
Update 2:
Yes KazJaw, other problem rises. ".Find" requires rs to be able to scrolled back, which requires its lockType to be set to adLockOptimistic. Haven't figured out how yet. Will post if I do.
Solution:
The Key is to use rs.Open instead of conn.Execute and to set CursorType.
Dim rs As ADOBE.Recordset
q = "select name, age from people where country = 'US' Order By i"
Set rs = New ADODB.Recordset
rs.Open Source:=q, CursorType:=adOpenStatic, ActiveConnection:=ThisWorkbook.conn 'conn is an ADOBE.Connection
For i = 30 To 40
name = rs.Find("age = i")!name 'this line is where I am not sure how to achieve
MsgBox name & "'s age is " & i
Next i
First solution, without looping, you could do it in this way but you need to stick to #mehow suggestion where age condition should be implemented in SQL query.
'return all results as of cell A2, direction down+right, in activesheet
ActiveSheet.Range("A2").CopyFromRecordset rs
Second solution, with looping, instead of your For i...Next loop try below solution.
Dim lRow as long
lRow=2
With rs
Do Until .EOF
'return only those which age equals to i
'if implemented in SQL query then you could get rid of if statement below
if .Fields(1).Value = i then
Cells(lRow, 1) = .Fields(1).Value
Cells(lRow, 2) = .Fields(2).Value
.MoveNext
lRow = lRow + 1
end if
Loop
End With
Third solution. If you really need to use .Find method then do it in this way:
'...your loop here
rs.Find "age = " & i
name = rs(0)
MsgBox name & "'s age is " & i
'... rest of your code here
Unfortunately, I'm not sure if it will work. I think you will need to sort your results by age within SQL code. If not I expect some of the ages can be omit. Some other problems could arise. Therefore try with other solutions.
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'