Private Sub cmd_Dish2_Click()
Call XFER_EXCEL_2007_V2
End Sub
Function XFER_EXCEL_2007_V2()
Dim rec1 As DAO.Recordset
Dim con1 As DAO.Database
Dim sqlstr As String
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Set xlApp = CreateObject("Excel.Application.12")
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Worksheets(1)
Dim objRec As Recordset
Dim strSheetName As String
Dim qryName As String
xlApp.Visible = True
qryName = "QRY_OUTPUT"
sqlstr = "SELECT * FROM " & qryName
Set con1 = CurrentDb()
Set rec1 = con1.OpenRecordset(sqlstr)
Set objRST = Application.CurrentDb.OpenRecordset(sqlstr)
strSheetName = qryName
Set xlSheet = xlBook.Sheets(1)
For lvlColumn = 0 To objRST.Fields.Count - 1
xlSheet.Cells(1, lvlColumn + 1).Value = objRST.Fields(lvlColumn).Name
Next
With xlSheet.Range("A2").Select
xlApp.ActiveWindow.FreezePanes = True
End With
xlSheet.Range(xlSheet.Cells(1, 1), _
xlSheet.Cells(1, objRST.Fields.Count)).Font.Bold = True
With xlSheet.Range(xlSheet.Cells(1, 1), xlSheet.Cells(1, objRST.Fields.Count)).Interior
.ColorIndex = 15
.Pattern = xlSolid
End With
With xlSheet.Range(xlSheet.Cells(1, 1), _
xlSheet.Cells(1, objRST.Fields.Count)).Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With xlSheet.Range(xlSheet.Cells(1, 1), _
xlSheet.Cells(1, objRST.Fields.Count)).Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With xlSheet.Range(xlSheet.Cells(1, 1), _
xlSheet.Cells(1, objRST.Fields.Count)).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With xlSheet.Range(xlSheet.Cells(1, 1), _
xlSheet.Cells(1, objRST.Fields.Count)).Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With xlSheet
xlApp.ActiveWindow.Zoom = 90
End With
With xlSheet
.Range("A2").CopyFromRecordset objRST
.Name = strSheetName
End With
With xlApp
xlApp.Sheets("Sheet2").Select
xlApp.ActiveWindow.SelectedSheets.Delete
xlApp.Sheets("Sheet3").Select
xlApp.ActiveWindow.SelectedSheets.Delete
End With
With xlSheet
.Cells.EntireColumn.AutoFit
.Cells.WrapText = False
End With
Set objRST = Nothing
Set xlApp = Nothing
Set xlBook = Nothing
Set xlSheet = Nothing
End Function