PeasNCarrots
Programmer
When I export data from Listbox to EXCEl in changes the numeric values to Dates in EXCEl. How do I prevent this? Here is my code:
Sub sCopySendAgainFromRS()
'Transfer Records to Excel
Dim rs As DAO.Recordset
Dim intMaxCol As Integer
Dim intMaxRow As Integer
Dim objXL As Excel.Application
Dim objWkb As Workbook
Dim objSht As Worksheet
Dim strSQl
Dim i As Integer
Dim db As DAO.Database
strSQl = Me.lstReport.RowSource
MsgBox strSQl
Set db = CurrentDb
Set rs = db.OpenRecordset(strSQl, dbOpenDynaset)
'Create New Excel App
Set objXL = New Excel.Application
intMaxCol = rs.Fields.Count
If rs.RecordCount > 0 Then
rs.MoveLast: rs.MoveFirst
intMaxRow = rs.RecordCount
End If
With objXL
.Visible = True
Set objWkb = .Workbooks.Add
Set objSht = objWkb.Worksheets(1)
objSht.Name = "OJS REPORT"
With objSht
'Page Setup
With .PageSetup
.Orientation = xlLandscape
.LeftMargin = 25
.RightMargin = 25
.TopMargin = 5
.BottomMargin = 5
.CenterHorizontally = True
End With
'Add Field Names
For i = 0 To intMaxCol - 1
.Cells(3, i + 1) = rs.Fields(i).Name
Next
'Copy Recordset to Cells
.Range(.Cells(4, 1), .Cells(intMaxRow, _
intMaxCol)).CopyFromRecordset rs
.Range("B2").Activate
.Range("A3:Z3").Font.Bold = True
.Range("A3:Z3").WrapText = True
.Columns("A:AZ").AutoFit
End With
End With
End Sub
Sub sCopySendAgainFromRS()
'Transfer Records to Excel
Dim rs As DAO.Recordset
Dim intMaxCol As Integer
Dim intMaxRow As Integer
Dim objXL As Excel.Application
Dim objWkb As Workbook
Dim objSht As Worksheet
Dim strSQl
Dim i As Integer
Dim db As DAO.Database
strSQl = Me.lstReport.RowSource
MsgBox strSQl
Set db = CurrentDb
Set rs = db.OpenRecordset(strSQl, dbOpenDynaset)
'Create New Excel App
Set objXL = New Excel.Application
intMaxCol = rs.Fields.Count
If rs.RecordCount > 0 Then
rs.MoveLast: rs.MoveFirst
intMaxRow = rs.RecordCount
End If
With objXL
.Visible = True
Set objWkb = .Workbooks.Add
Set objSht = objWkb.Worksheets(1)
objSht.Name = "OJS REPORT"
With objSht
'Page Setup
With .PageSetup
.Orientation = xlLandscape
.LeftMargin = 25
.RightMargin = 25
.TopMargin = 5
.BottomMargin = 5
.CenterHorizontally = True
End With
'Add Field Names
For i = 0 To intMaxCol - 1
.Cells(3, i + 1) = rs.Fields(i).Name
Next
'Copy Recordset to Cells
.Range(.Cells(4, 1), .Cells(intMaxRow, _
intMaxCol)).CopyFromRecordset rs
.Range("B2").Activate
.Range("A3:Z3").Font.Bold = True
.Range("A3:Z3").WrapText = True
.Columns("A:AZ").AutoFit
End With
End With
End Sub