G
Guest
I have a button with VB code that exports all the data from a table to Excel.
The problem is that some of the fields in the table are linked to other
tables that have autonumbers as primary keys, but I need the text fields and
not the associated numbers to be exported to spreadsheet. Is there any to do
this with VB code or will I need to reset all the primary keys to the text
fields? The code I'm using is listed below. Thanks!
---------------------------------
Private Sub cmdExcel_Click()
Dim db As DAO.Database
Dim rs As DAO.Recordset
Set db = CurrentDb
Set rs = db.OpenRecordset("qryMain", dbOpenSnapshot)
Dim oApp As New Excel.Application
Dim oBook As Excel.Workbook
Dim oSheet As Excel.Worksheet
Set oBook = oApp.Workbooks.Add
Set oSheet = oApp.ActiveSheet
Dim i As Integer
Dim iNumCols As Integer
iNumCols = rs.Fields.Count
For i = 1 To iNumCols
oSheet.Cells(1, i).Value = rs.Fields(i - 1).Name
Next
oSheet.Range("A2").CopyFromRecordset rs
With oSheet.Range("a1").Resize(1, iNumCols)
..Font.Bold = True
..EntireColumn.AutoFit
End With
oApp.Visible = True
oApp.UserControl = True
rs.Close
db.Close
End Sub
The problem is that some of the fields in the table are linked to other
tables that have autonumbers as primary keys, but I need the text fields and
not the associated numbers to be exported to spreadsheet. Is there any to do
this with VB code or will I need to reset all the primary keys to the text
fields? The code I'm using is listed below. Thanks!
---------------------------------
Private Sub cmdExcel_Click()
Dim db As DAO.Database
Dim rs As DAO.Recordset
Set db = CurrentDb
Set rs = db.OpenRecordset("qryMain", dbOpenSnapshot)
Dim oApp As New Excel.Application
Dim oBook As Excel.Workbook
Dim oSheet As Excel.Worksheet
Set oBook = oApp.Workbooks.Add
Set oSheet = oApp.ActiveSheet
Dim i As Integer
Dim iNumCols As Integer
iNumCols = rs.Fields.Count
For i = 1 To iNumCols
oSheet.Cells(1, i).Value = rs.Fields(i - 1).Name
Next
oSheet.Range("A2").CopyFromRecordset rs
With oSheet.Range("a1").Resize(1, iNumCols)
..Font.Bold = True
..EntireColumn.AutoFit
End With
oApp.Visible = True
oApp.UserControl = True
rs.Close
db.Close
End Sub