Import Excel to Access using VBA
'JGDJSS Designed by Deepak Lohia at DeepakLohia.com
Option Compare Database Option Explicit Private Sub btnBrowse_Click() Dim diag As Office.FileDialog Dim item As Variant Set diag = Application.FileDialog(msoFileDialogFilePicker) diag.AllowMultiSelect = False diag.Title = "Please select an Excel Spreadsheet" diag.Filters.Clear diag.Filters.Add "Excel Spreadsheets", "*.xls, *.xlsx" If diag.Show Then For Each item In diag.SelectedItems Me.txtFileName = item 'here we input the select excel file name in textbox Next End If End Sub Private Sub btnImportSpreadsheet_Click() Dim FSO As New FileSystemObject If FSO.FileExists(Nz(Me.txtFileName, "")) Then ImportExcelSpreadsheet Me.txtFileName, FSO.GetFileName(Me.txtFileName) ElseIf Nz(Me.txtFileName, "") = "" Then MsgBox "Please select a file!", vbExclamation Else MsgBox "File not found!", vbExclamation End If End Sub Public Sub ImportExcelSpreadsheet(fileName As String, tableName As String) On Error Resume Next DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, tableName, fileName, True If Err.Number = 3125 Then If vbOK = MsgBox(Err.Description & vbNewLine & vbNewLine & "Skip column header and continu ?", vbExclamation + vbOKCancel, "Error with Excel Column header") Then DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, tableName, fileName, False MsgBox "Done", vbInformation End If Exit Sub ElseIf Err.Number <> 0 Then MsgBox Err.Number & ":" & Err.Description, vbCritical Exit Sub End If MsgBox "Done", vbInformation End Sub Private Sub Command5_Click() Application.FollowHyperlink "https://www.youtube.com/channel/UCfw5bPQzVXGt5swIOWVQz8Q?sub_confirmation=1" End Sub
No comments:
Post a Comment
Note: Only a member of this blog may post a comment.