How to get each table's first line of record and write into excel?

I got the code to catch the table's name and fields name and write them to an
Excel two days ago.

I am wondering can I also write the first record of each table in to Excel?

I got almost 700+ tables in a database. Now i summerized tables' name and
fields name. I want to give a example of each table's record. So i want the
first row.

Is there anyone know how to get it?

I have the code put out the table and field names to an Excel file:

"
Sub TableAndFieldList()
Dim lngTable As Long
Dim lngField As Long
Dim db As Database
Dim xlApp As Object
Dim wbExcel As Object
Dim ws As Worksheet
Dim lngRow As Long
Set db = CurrentDb
Set xlApp = CreateObject("Excel.Application")
Set wbExcel = xlApp.Workbooks.Add
lngRow = 1
On Error Resume Next
'Put out some column Headers
With wbExcel.Sheets(1)
..Range("A" & lngRow) = "Table"
..Range("B" & lngRow) = "FieldName"
..Range("C" & lngRow) = "FieldLen"
..Range("D" & lngRow) = "FieldType"
End With
Set ws = wbExcel.Sheets(1)
With ws.Range("A11").Font
..Bold = True
..Name = "MS Sans Serif"
..Size = 8.5
End With
ws.Range("A11").HorizontalAlignment = xlCenter
ws.Range("A11").Interior.ColorIndex = 15


ws.Range("A11").Borders(xlDiagonalDown).LineStyl e = xlNone
ws.Range("A11").Borders(xlDiagonalUp).LineStyle = xlNone
With ws.Range("A11").Borders(xlEdgeLeft)
..LineStyle = xlContinuous
..Weight = xlThin
..ColorIndex = xlAutomatic
End With
With ws.Range("A11").Borders(xlEdgeTop)
..LineStyle = xlContinuous
..Weight = xlThin
..ColorIndex = xlAutomatic
End With
With ws.Range("A11").Borders(xlEdgeBottom)
..LineStyle = xlContinuous
..Weight = xlThin
..ColorIndex = xlAutomatic
End With
With ws.Range("A11").Borders(xlEdgeRight)
..LineStyle = xlContinuous
..Weight = xlThin
..ColorIndex = xlAutomatic
End With
With ws.Range("A11").Borders(xlInsideVertical)
..LineStyle = xlContinuous
..Weight = xlThin
..ColorIndex = xlAutomatic
End With

ws.Range("A2").Select
xlApp.Windows(1).FreezePanes = True

'Loop through all tables
For lngTable = 0 To db.TableDefs.Count
'Do nothing if temporary or system table
If Left(db.TableDefs(lngTable).Name, 1) = "~" Or _
Left(db.TableDefs(lngTable).Name, 4) = "MSYS" Then
Else
'Loop through each table, writing the table and field names
'to an Excel file
For lngField = 0 To db.TableDefs(lngTable).Fields.Count - 1
'For lngField = 0 To 2
lngRow = lngRow + 1
With wbExcel.Sheets(1)
..Range("A" & lngRow) = db.TableDefs(lngTable).Name
..Range("B" & lngRow) =
db.TableDefs(lngTable).Fields(lngField).Name
..Range("C" & lngRow) =
db.TableDefs(lngTable).Fields(lngField).Size
..Range("D" & lngRow) =
db.TableDefs(lngTable).Fields(lngField).Type
End With
Next lngField
lngRow = lngRow + 2
End If
Next lngTable
'Errors back in effect
On Error GoTo 0
ws.Columns("A:B").Select
ws.Columns("A:B").EntireColumn.AutoFit
'Set Excel to visible so user can save or let go
xlApp.Visible = True
Set xlApp = Nothing
Set wbExcel = Nothing
Set db = Nothing

End Sub
"

What you believe is the "first record" and what Access believes is the
"first record" may not be the same. How are you defining "first record?"
"XS" wrote in message
...
I got the code to catch the table's name and fields name and write them to
an
Excel two days ago.

I am wondering can I also write the first record of each table in to
Excel?

I got almost 700+ tables in a database. Now i summerized tables' name and
fields name. I want to give a example of each table's record. So i want
the
first row.

Is there anyone know how to get it?

I have the code put out the table and field names to an Excel file:

"
Sub TableAndFieldList()
Dim lngTable As Long
Dim lngField As Long
Dim db As Database
Dim xlApp As Object
Dim wbExcel As Object
Dim ws As Worksheet
Dim lngRow As Long
Set db = CurrentDb
Set xlApp = CreateObject("Excel.Application")
Set wbExcel = xlApp.Workbooks.Add
lngRow = 1
On Error Resume Next
'Put out some column Headers
With wbExcel.Sheets(1)
.Range("A" & lngRow) = "Table"
.Range("B" & lngRow) = "FieldName"
.Range("C" & lngRow) = "FieldLen"
.Range("D" & lngRow) = "FieldType"
End With
Set ws = wbExcel.Sheets(1)
With ws.Range("A11").Font
.Bold = True
.Name = "MS Sans Serif"
.Size = 8.5
End With
ws.Range("A11").HorizontalAlignment = xlCenter
ws.Range("A11").Interior.ColorIndex = 15


ws.Range("A11").Borders(xlDiagonalDown).LineStyl e = xlNone
ws.Range("A11").Borders(xlDiagonalUp).LineStyle = xlNone
With ws.Range("A11").Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With ws.Range("A11").Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With ws.Range("A11").Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With ws.Range("A11").Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With ws.Range("A11").Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

ws.Range("A2").Select
xlApp.Windows(1).FreezePanes = True

'Loop through all tables
For lngTable = 0 To db.TableDefs.Count
'Do nothing if temporary or system table
If Left(db.TableDefs(lngTable).Name, 1) = "~" Or _
Left(db.TableDefs(lngTable).Name, 4) = "MSYS" Then
Else
'Loop through each table, writing the table and field names
'to an Excel file
For lngField = 0 To db.TableDefs(lngTable).Fields.Count - 1
'For lngField = 0 To 2
lngRow = lngRow + 1
With wbExcel.Sheets(1)
.Range("A" & lngRow) = db.TableDefs(lngTable).Name
.Range("B" & lngRow) =
db.TableDefs(lngTable).Fields(lngField).Name
.Range("C" & lngRow) =
db.TableDefs(lngTable).Fields(lngField).Size
.Range("D" & lngRow) =
db.TableDefs(lngTable).Fields(lngField).Type
End With
Next lngField
lngRow = lngRow + 2
End If
Next lngTable
'Errors back in effect
On Error GoTo 0
ws.Columns("A:B").Select
ws.Columns("A:B").EntireColumn.AutoFit
'Set Excel to visible so user can save or let go
xlApp.Visible = True
Set xlApp = Nothing
Set wbExcel = Nothing
Set db = Nothing

End Sub
"

Hi Jeff,

Actully, I just want an sample of those tables. I dont care weather they are
the first or not.
It could be any row/record of one table.

Thanks.

"Jeff Boyce" wrote:

What you believe is the "first record" and what Access believes is the
"first record" may not be the same. How are you defining "first record?"
"XS" wrote in message
...
I got the code to catch the table's name and fields name and write them to
an
Excel two days ago.

I am wondering can I also write the first record of each table in to
Excel?

I got almost 700+ tables in a database. Now i summerized tables' name and
fields name. I want to give a example of each table's record. So i want
the
first row.

Is there anyone know how to get it?

I have the code put out the table and field names to an Excel file:

"
Sub TableAndFieldList()
Dim lngTable As Long
Dim lngField As Long
Dim db As Database
Dim xlApp As Object
Dim wbExcel As Object
Dim ws As Worksheet
Dim lngRow As Long
Set db = CurrentDb
Set xlApp = CreateObject("Excel.Application")
Set wbExcel = xlApp.Workbooks.Add
lngRow = 1
On Error Resume Next
'Put out some column Headers
With wbExcel.Sheets(1)
.Range("A" & lngRow) = "Table"
.Range("B" & lngRow) = "FieldName"
.Range("C" & lngRow) = "FieldLen"
.Range("D" & lngRow) = "FieldType"
End With
Set ws = wbExcel.Sheets(1)
With ws.Range("A11").Font
.Bold = True
.Name = "MS Sans Serif"
.Size = 8.5
End With
ws.Range("A11").HorizontalAlignment = xlCenter
ws.Range("A11").Interior.ColorIndex = 15


ws.Range("A11").Borders(xlDiagonalDown).LineStyl e = xlNone
ws.Range("A11").Borders(xlDiagonalUp).LineStyle = xlNone
With ws.Range("A11").Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With ws.Range("A11").Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With ws.Range("A11").Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With ws.Range("A11").Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With ws.Range("A11").Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

ws.Range("A2").Select
xlApp.Windows(1).FreezePanes = True

'Loop through all tables
For lngTable = 0 To db.TableDefs.Count
'Do nothing if temporary or system table
If Left(db.TableDefs(lngTable).Name, 1) = "~" Or _
Left(db.TableDefs(lngTable).Name, 4) = "MSYS" Then
Else
'Loop through each table, writing the table and field names
'to an Excel file
For lngField = 0 To db.TableDefs(lngTable).Fields.Count - 1
'For lngField = 0 To 2
lngRow = lngRow + 1
With wbExcel.Sheets(1)
.Range("A" & lngRow) = db.TableDefs(lngTable).Name
.Range("B" & lngRow) =
db.TableDefs(lngTable).Fields(lngField).Name
.Range("C" & lngRow) =
db.TableDefs(lngTable).Fields(lngField).Size
.Range("D" & lngRow) =
db.TableDefs(lngTable).Fields(lngField).Type
End With
Next lngField
lngRow = lngRow + 2
End If
Next lngTable
'Errors back in effect
On Error GoTo 0
ws.Columns("A:B").Select
ws.Columns("A:B").EntireColumn.AutoFit
'Set Excel to visible so user can save or let go
xlApp.Visible = True
Set xlApp = Nothing
Set wbExcel = Nothing
Set db = Nothing

End Sub
"

Take a look at Access HELP for a "Totals" query. Use the "First" (or
"Last") aggregation to get a single record.

Or, if you need a random record, try searching on-line for random record and
Access.

Regards

Jeff Boyce
Microsoft Office/Access MVP


"XS" wrote in message
...
Hi Jeff,

Actully, I just want an sample of those tables. I dont care weather they
are
the first or not.
It could be any row/record of one table.

Thanks.

"Jeff Boyce" wrote:

What you believe is the "first record" and what Access believes is the
"first record" may not be the same. How are you defining "first record?"
"XS" wrote in message
...
I got the code to catch the table's name and fields name and write them
to
an
Excel two days ago.

I am wondering can I also write the first record of each table in to
Excel?

I got almost 700+ tables in a database. Now i summerized tables' name
and
fields name. I want to give a example of each table's record. So i want
the
first row.

Is there anyone know how to get it?

I have the code put out the table and field names to an Excel file:

"
Sub TableAndFieldList()
Dim lngTable As Long
Dim lngField As Long
Dim db As Database
Dim xlApp As Object
Dim wbExcel As Object
Dim ws As Worksheet
Dim lngRow As Long
Set db = CurrentDb
Set xlApp = CreateObject("Excel.Application")
Set wbExcel = xlApp.Workbooks.Add
lngRow = 1
On Error Resume Next
'Put out some column Headers
With wbExcel.Sheets(1)
.Range("A" & lngRow) = "Table"
.Range("B" & lngRow) = "FieldName"
.Range("C" & lngRow) = "FieldLen"
.Range("D" & lngRow) = "FieldType"
End With
Set ws = wbExcel.Sheets(1)
With ws.Range("A11").Font
.Bold = True
.Name = "MS Sans Serif"
.Size = 8.5
End With
ws.Range("A11").HorizontalAlignment = xlCenter
ws.Range("A11").Interior.ColorIndex = 15


ws.Range("A11").Borders(xlDiagonalDown).LineStyl e = xlNone
ws.Range("A11").Borders(xlDiagonalUp).LineStyle = xlNone
With ws.Range("A11").Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With ws.Range("A11").Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With ws.Range("A11").Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With ws.Range("A11").Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With ws.Range("A11").Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

ws.Range("A2").Select
xlApp.Windows(1).FreezePanes = True

'Loop through all tables
For lngTable = 0 To db.TableDefs.Count
'Do nothing if temporary or system table
If Left(db.TableDefs(lngTable).Name, 1) = "~" Or _
Left(db.TableDefs(lngTable).Name, 4) = "MSYS" Then
Else
'Loop through each table, writing the table and field names
'to an Excel file
For lngField = 0 To db.TableDefs(lngTable).Fields.Count - 1
'For lngField = 0 To 2
lngRow = lngRow + 1
With wbExcel.Sheets(1)
.Range("A" & lngRow) = db.TableDefs(lngTable).Name
.Range("B" & lngRow) =
db.TableDefs(lngTable).Fields(lngField).Name
.Range("C" & lngRow) =
db.TableDefs(lngTable).Fields(lngField).Size
.Range("D" & lngRow) =
db.TableDefs(lngTable).Fields(lngField).Type
End With
Next lngField
lngRow = lngRow + 2
End If
Next lngTable
'Errors back in effect
On Error GoTo 0
ws.Columns("A:B").Select
ws.Columns("A:B").EntireColumn.AutoFit
'Set Excel to visible so user can save or let go
xlApp.Visible = True
Set xlApp = Nothing
Set wbExcel = Nothing
Set db = Nothing

End Sub
"