MS Access: Export excel from MS Access and perform Formatting

I needed to export data from access and do some formatting at the same time. So this code helped me to perform this.
Private Sub Command0_Click()

Dim db As DAO.Database
Set db = CurrentDb()

' Drop table if exists
If ifTableExists("ACCESS_TABLE") Then db.Execute "DROP Table ACCESS_TABLE"

' Import data from SQL table
DoCmd.TransferDatabase acTable, "ODBC Database", _
"ODBC;Driver={SQL Server};Server=192.168.0.0;UID=username;PWD=password;LANGUAGE=us_english;" _
& "DATABASE=DatabaseName", acTable, "SQL_TABLE", "ACCESS_TABLE"

'Excel Export and Formatting

Dim n1 As String
Dim xl As Excel.Application
Dim XlBook As Excel.Workbook
Dim xlsheet1 As Excel.Worksheet

n1 = CurrentProject.Path + "\DestinationExcelName.xlsx"
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "ACCESS_TABLE", n1, True

On Error Resume Next
Set xl = GetObject(n1, "Excel.Application")
On Error GoTo 0
If xl Is Nothing Then
  Set xl = CreateObject("Excel.Application")
End If

Set XlBook = GetObject(n1)

'Make sure excel is visible on the screen
xl.Visible = True
XlBook.Windows(1).Visible = True

'Define the sheet in the Workbook as XlSheet
Set xlsheet1 = XlBook.Worksheets(1)
XlBook.Activate
AppActivate xl.Caption

With xlsheet1
    .range("A1:C1").Interior.Color = RGB(192, 192, 192) ' Grey "Fill color"
    .range("D1:F1").Interior.Color = RGB(255, 255, 0) ' Yellow "Fill color"
    .range("G1:I1").Interior.Color = RGB(255, 204, 153) ' Orange "Fill color"

    .range("A1:C1").Font.Color = RGB(255, 255, 255) ' White "Font color"
    .rows("1:1").Font.Bold = True  ' "Font weight - Bold"

End With

XlBook.Save

MsgBox "DestinationExcelName.xlsx file exported. Please check"

End Sub


Public Function ifTableExists(tablename As String) As Boolean

ifTableExists = False
If DCount("[Name]", "MSysObjects", "[Name] = '" & tablename & "'") = 1 Then
ifTableExists = True
Else
ifTableExists = False
End If

End Function

No comments:

Post a Comment