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