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.