Export data from MS access to NS Excel from Form (1 Viewer)

Bunga2017

Registered User.
Local time
Today, 10:13
Joined
Mar 24, 2017
Messages
19
Can someone help me with vba to export to Excel format (Access 2010).
I use below VBA, Export from combobox working fine see(frm_ExportDataExample) but how to export from FORM see (frmToExcel)



Private Sub cbo_ContactName_AfterUpdate()
Me.cmd_Send2XLS.Enabled = Not IsNull(Me.cbo_ContactName)
End Sub
---------------------------------------------------
Private Sub cmd_Send2Xls_Click()
Dim sXlsFile As String

sXlsFile = CurrentProject.Path & "\Customer.xlsx"
Call ExportRecordset2XLS(sXlsFile, "SELECT * FROM tblCustomer WHERE ID=" & Me.cbo_ContactName)
End Sub

----------------------------------------------------


Private Sub Form_Load()
Me.cmd_Send2XLS.Enabled = False
End Sub

----------------------------------------------------


mod_MSExcel :
==========

Function ExportRecordset2XLS(sXlsFile As String, sQuery As String)
Dim oExcel As Object
Dim oExcelWrkBk As Object
Dim oExcelWrSht As Object
Dim bExcelOpened As Boolean
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim iCols As Integer
Const xlCenter = -4108



On Error Resume Next
Set oExcel = GetObject(, "Excel.Application")


If Err.Number <> 0 Then
Err.Clear
On Error GoTo Error_Handler
Set oExcel = CreateObject("excel.application")
bExcelOpened = False
Else
bExcelOpened = True
End If
On Error GoTo Error_Handler
oExcel.ScreenUpdating = False
oExcel.Visible = True
Set oExcelWrkBk = oExcel.Workbooks.Open(sXlsFile)
DoEvents
Set oExcelWrSht = oExcelWrkBk.Sheets(2)
oExcelWrSht.Activate



Set db = CurrentDb
Set rs = db.OpenRecordset(sQuery, dbOpenSnapshot)
With rs
If .RecordCount <> 0 Then

For iCols = 0 To rs.Fields.Count - 1
oExcelWrSht.Cells(5, iCols + 1).Value = rs.Fields(iCols).Name
Next
With oExcelWrSht.Range(oExcelWrSht.Cells(5, 1), _
oExcelWrSht.Cells(5, rs.Fields.Count))
.Font.Bold = True
.Font.ColorIndex = 2
.Interior.ColorIndex = 1
.HorizontalAlignment = xlCenter
End With


oExcelWrSht.Cells.EntireColumn.AutoFit
oExcelWrSht.Columns("Q:Q").ColumnWidth = 101.86
oExcelWrSht.Cells.EntireRow.AutoFit



oExcelWrSht.Range("A6").CopyFromRecordset rs
oExcelWrSht.Range("A1").Select
Else
MsgBox "There are no records returned by the specified queries/SQL statement.", vbCritical + vbOKOnly, "No data to generate an Excel spreadsheet with"
GoTo Error_Handler_Exit
End If
End With





Error_Handler_Exit:
On Error Resume Next
oExcel.Visible = True
rs.Close
Set rs = Nothing
Set db = Nothing
Set oExcelWrSht = Nothing
Set oExcelWrkBk = Nothing
oExcel.ScreenUpdating = True
Set oExcel = Nothing
Exit Function


Error_Handler:
MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: ExportRecordset2XLS" & vbCrLf & _
"Error Description: " & Err.Description _
, vbOKOnly + vbCritical, "An Error has Occured!"
Resume Error_Handler_Exit
End Function

Thank you in advance for your help
 

Attachments

  • Contact.accdb
    896 KB · Views: 409

Bunga2017

Registered User.
Local time
Today, 10:13
Joined
Mar 24, 2017
Messages
19
See below the excel file
 

Attachments

  • Excel File.zip
    6.9 KB · Views: 422

Users who are viewing this thread

Top Bottom