I have 2 sheets( sheet1 & sheet2) in temp.xlsx. From sheet1 I need to read specific data into one table. From sheet2 I need to read from A3 to Y; some time it will have 2 records and some time it will have 100 records; into another table.
Code:
Private Sub cmd_imp_Click()
On Error GoTo Err_cmd_imp_Click
Dim lngColumn As Integer 'Double
Dim xlx As Object, xlw As Object, xls As Object, xlc As Object
Dim rst As DAO.Recordset, MyRec As DAO.Recordset, Myext As DAO.Recordset
Dim blnEXCEL As Boolean
blnEXCEL = True
Dim strFileName As String
Dim strFileLoc As String
Dim Filepath As String
Dim StrSheetName As String
Dim f As Object
Dim varItem As Variant
Set f = Application.FileDialog(3)
f.AllowMultiSelect = True
If f.Show Then
For Each varItem In f.SelectedItems
strFileName = Dir(varItem)
strFileLoc = Left(varItem, Len(varItem) - Len(strFileName))
strFilePath = strFileLoc & strFileName
StrSheetName = Lab_Facility_Details
Next
End If
' Establish an EXCEL application object
On Error Resume Next
Set xlx = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
Set xlx = CreateObject("Excel.Application")
blnEXCEL = True
End If
Err.Clear
On Error GoTo 0
DoCmd.RunSQL "Delete * from sheet1_temp;"
xlx.Visible = True
DoCmd.SetWarnings False
Set xlw = xlx.Workbooks.Open(strFilePath, , True)
Set xls = xlw.Worksheets("sheet1") '(StrSheetName)
Set MyRec = CurrentDb.OpenRecordset("sheet1_temp")
MyRec.AddNew
MyRec.Fields("File_name") = strFileName
MyRec.Fields("LName") = xls.cells(2, "C")
MyRec.Fields("LAddress1") = xls.cells(3, "C")
MyRec.Fields("LCity") = xls.cells(5, "C")
MyRec.Fields("LState") = xls.cells(6, "C")
MyRec.Fields("LPostalCode") = xls.cells(7, "C")
MyRec.Update
DoCmd.OpenQuery "Append_Temp_sheet1_Details"
MyRec.Close
Set MyRec = Nothing
'Read sheet 2 data from A3 onwards
Set xls = xlw.Worksheets("sheet2") '
DoCmd.SetWarnings False
DoCmd.RunSQL "Delete * from sheet2_temp;"
DoCmd.SetWarnings True
Set xlc = xls.Range("A3")
Set rst = CurrentDb.OpenRecordset("sheet2_temp") ', dbOpenDynaset, dbAppendOnly)
' write data to the recordset
If xlc.Value = " " Then
Exit Sub
Else
For i = 0 To 100
rst.AddNew
For lngColumn = 0 To rst.Fields.Count - 1
rst.Fields(lngColumn).Value = xlc.Offset(i, lngColumn).Value
' MsgBox xlc.Offset(i, lngColumn).Value
Next lngColumn
rst.Fields("File_name") = strFileName
rst.Update
'Set xlc = xlc.Offset(1, 0)
Next i
End If
' DoCmd.OpenQuery "Append_temp_res_to_tbl_res"
'Set MyRec = Nothing
xlw.Close False
Set xlw = Nothing
If blnEXCEL = True Then xlx.Quit
Set xlx = Nothing
Exit_cmd_imp_Click:
Exit Sub
Err_cmd_imp_Click:
' MsgBox Err.Description
MsgBox "Error No: " & Err.Number _
& vbNewLine _
& Err.Description, _
vbExclamation + vbOKOnly, _
"Error Information"
Resume Exit_cmd_imp_Click
End Sub
[/QUOTE]