Friday, August 16, 2019

import data from excel to access vba on a click







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.