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
-------------------------------------------------------------------------------------------------------
Thanks, TAMATAM ; Business Intelligence & Analytics Professional
--------------------------------------------------------------------------------------------------------
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 :
-------------------------------------------------------------------------------------------------------
Thanks, TAMATAM ; Business Intelligence & Analytics Professional
--------------------------------------------------------------------------------------------------------
No comments:
Post a Comment
Hi User, Thank You for visiting My Blog. Please post your genuine Feedback or comments only related to this Blog Posts. Please do not post any Spam comments or Advertising kind of comments which will be Ignored.