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
SrcSht.Activate

'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>
SrcSht.Range(MyRange).Select

Selection.NumberFormat = "General"
SrcSht.Range(MyRange).Copy
    
'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
    xlApp.Quit
    
'CloseCurrentDatabase
'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 :



No comments:

Post a Comment

Follow Me by Email

ExcelKingdom-Popular Posts

ExcelKingdom-Random Posts