Sub test() Dim con As Object Set con = Application.CurrentProject.Connection Dim rstExcel As ADODB.Recordset Dim strSQLExcel As String Dim i As Integer, j As Integer Dim ssql As String, xlFile As String Dim xlObj As Object Dim Sheet As Object strSQLExcel = "SELECT * from DR_Accs" Set rstExcel = CreateObject("ADODB.Recordset") rstExcel.Open strSQLExcel, con, 1 ' 1 = adOpenKeyset Set xlObj = CreateObject("Excel.Application") xlObj.Workbooks.Add Set Sheet = xlObj.ActiveWorkbook.Sheets(1) 'copy the headers Dim iRow, iCol iRow = 1 For iCol = 0 To rstExcel.Fields.Count - 1 Sheet.Cells(iRow, iCol + 1).Value = rstExcel.Fields(iCol).NAME Next Sheet.Range("A2").CopyFromRecordset rstExcel xlObj.Visible = True Sheet.Rows("1:1").Font.Bold = True Dim dblLastRow As Double With Sheet.Range("A1").CurrentRegion .EntireColumn.AutoFit dblLastRow = .Rows.Count End With If CInt(xlObj.Version) = 12 Then Dim strRangeCell As String strRangeCell = Sheet.Cells(dblLastRow, rstExcel.Fields.Count).Address Dim strTableName As String strTableName = "Table" & Format(Now, "ddmmyyhmm") xlObj.ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$1", strRangeCell), , xlYes).NAME = strTableName xlObj.Range(strTableName & "[#All]").Select xlObj.ActiveSheet.ListObjects(strTableName).TableStyle = "TableStyleMedium2" End If Set Sheet = Nothing Set xlObj = Nothing End Sub
Experts Exchange always has the answer, or at the least points me in the correct direction! It is like having another employee that is extremely experienced.
When asked, what has been your best career decision?
Deciding to stick with EE.
Being involved with EE helped me to grow personally and professionally.
Connect with Certified Experts to gain insight and support on specific technology challenges including:
We've partnered with two important charities to provide clean water and computer science education to those who need it most. READ MORE