Wednesday, 6 May 2015

Access VBA Macro to Copy Excel Data Range to Access Database Table

How  to Copy Excel Data Range to Access Database Table using Access VBA Macro
Option Compare Database
Sub Import_Excel_Data_2_Access()
Dim WS As Object
Dim SrcSht As Object
Dim Tgt_File As Object
Dim IP_File

Dim xlApp As Object
'Dim xlApp As Excel.Application
Dim DataLastCell As Object

Dim F_Dialog As FileDialog

On Error Resume Next

Set F_Dialog = Application.FileDialog(msoFileDialogFilePicker)
Set xlApp = CreateObject("Excel.Application")
'Set xlApp = New Excel.Application

xlApp.DisplayAlerts = False
DoCmd.SetWarnings False

'Setting the File Picker Open Dialog box Properties
With F_Dialog
.AllowMultiSelect = False
.Title = "Please Select the Input File"
.Filters.Add "Microsoft Excel Files (*.xls*)", "*.xls*"
'.Filters.Add "Text Files (*.txt*)", "*.txt*"
'.Filters.Add "Microsoft Access Files (*.accdb*)", "*.accdb*"
'.Filters.Add "Microsoft Access Files (*.mdb*)", "*.mdb*"
End With

'Assigning the File picked from Dialog box to a Variable
If F_Dialog.Show = True Then
      If F_Dialog.SelectedItems(1) <> vbNullString Then
        IP_File = F_Dialog.SelectedItems(1)
    End If
End If

 If IP_File = False Then Exit Sub

 xlApp.Application.Visible = True
 Set Tgt_File = xlApp.Workbooks.Open(IP_File)
 Set SrcSht = Tgt_File.Sheets("Data")

'Finding the Dynamic Used Range from Source Data Sheet

'To Find the Last Row Number with data in the Range
        Set DataLastCell = SrcSht.Cells.Find("*", SrcSht.Cells(1, 1), , , xlByRows, xlPrevious)
        RC = DataLastCell.Rows.Count
'To Find the Last Column Number with data in the Range
        Set DataLastCell = SrcSht.Cells.Find("*", SrcSht.Cells(1, 1), , , xlByColumns, xlPrevious)
        CC = DataLastCell.Column
'To Find the End of the Range in  Data
        DR = DataLastCell.Address
Set MyRng = SrcSht.Range("A1:" & DR)
MyRange = MyRng.Address

'Selecting Data Range and Changing the Data format to <General>

Selection.NumberFormat = "General"
'Open Database Table and Dumping the Input Data then Closing the Table
    DoCmd.OpenTable "Sales", acViewNormal, acEdit
    DoCmd.RunCommand acCmdPasteAppend
    DoCmd.Close acTable, "Sales", acSaveYes
DoCmd.SetWarnings True

    Tgt_File.Close , SaveChanges:=False
    xlApp.DisplayAlerts = True
'DoCmd.Quit acQuitSaveAll
MsgBox "The <Sales> Table has been Updated Successfully", vbOKCancel, "Job Over"
End Sub

Notes :
To Work with Excel VBA Objects in Access VBA , We need to Activate the required Libraries for Reference (Microsoft Excel 14.0 Object Library) as follows , Otherwise Access VBA cannot understand the Excel VBA Objects :

Thanks, TAMATAM ; Business Intelligence & Analytics Professional

No comments:

Post a Comment

Hi User, Thank You for visiting My Blog. Please post your open Feedback only related to this Blog Posts. Please note that I cannot respond to the Anonymous Comments.

Subscribe to Blog Posts by Email

ExcelKingdom-Popular Posts