Results 1 to 4 of 4
  1. #1
    stalk is offline Competent Performer
    Windows 8 Access 2003
    Join Date
    May 2014
    Posts
    139

    Reading specific data into Access from multiple worksheets in the same excel workbook using VBA..

    Below code works fine to read Sheet1 "Facility_Details" and stops when going to Sheet2 "Bulk_Results_ReportingSheet".


    Worked fine last week but I modified many things and now it stopped working. Any help is much appreciated?


    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 Facility_Details_temp;"
    xlx.Visible = True
      DoCmd.SetWarnings False
    Set xlw = xlx.Workbooks.Open(strFilePath, , True)
    Set xls = xlw.Worksheets("Facility_Details")   '(StrSheetName)
    'If xls.Value = "Lab_Facility_Details" Then
      Set MyRec = CurrentDb.OpenRecordset("Facility_Details_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_tbl_Facility_Details"
      MyRec.Close
      Set MyRec = Nothing
    'Read sheet 2 data from A3 onwards
    'Set xlw = xlx.Workbooks.Open(strFilePath, , True)
      Set xls = xlw.Worksheets("Bulk_Results_ReportingSheet") ' Fails/stops at this point saying subscript out of range
       DoCmd.SetWarnings False
       DoCmd.RunSQL "Delete * from BulkResults_temp;"
       DoCmd.SetWarnings True
    Set xlc = xls.Range("A3")
    Set rst = CurrentDb.OpenRecordset("BulkResults_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

  2. #2
    ranman256's Avatar
    ranman256 is online now VIP
    Windows Vista Access 2010 32bit
    Join Date
    Apr 2014
    Location
    Kentucky
    Posts
    8,695
    here:
    set xls= xlw.Worksheets("Bulk_Results_ReportingSheet")

    xls MUST be defined as a worksheet
    "Bulk_Results_ReportingSheet" MUST be the exact name of the sheet.
    xlw MUST be an active workbook and the variable xlw assigned

  3. #3
    stalk is offline Competent Performer
    Windows 8 Access 2003
    Join Date
    May 2014
    Posts
    139
    Quote Originally Posted by ranman256 View Post
    here:
    set xls= xlw.Worksheets("Bulk_Results_ReportingSheet")

    xls MUST be defined as a worksheet
    "Bulk_Results_ReportingSheet" MUST be the exact name of the sheet.
    xlw MUST be an active workbook and the variable xlw assigned

    All these objects are defined at the top:
    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

  4. #4
    ssanfu is offline Master of Nothing
    Windows 7 32bit Access 2010 32bit
    Join Date
    Sep 2010
    Location
    Anchorage, Alaska, USA
    Posts
    9,199
    Have you seen Ken Snell's web site for Importing/Exporting Excel workbooks? http://www.accessmvp.com/kdsnell/EXCEL_MainPage.htm
    This was my reference when learning Excel automation....
    HTH
    -----
    Steve
    --------------------------------
    "Veni, Vidi, Velcro"
    (I came; I saw; I stuck around.)

Please reply to this thread with any new information or opinions.

Similar Threads

  1. Replies: 2
    Last Post: 08-28-2015, 01:23 PM
  2. Importing Excel Workbook with multiple Worksheets
    By MTSPEER in forum Programming
    Replies: 4
    Last Post: 04-21-2015, 01:50 PM
  3. Replies: 2
    Last Post: 10-15-2014, 12:30 PM
  4. Replies: 17
    Last Post: 06-25-2013, 05:22 PM
  5. Deleting Worksheets on a Excel workbook
    By BED in forum Programming
    Replies: 0
    Last Post: 07-27-2010, 01:20 PM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  
Other Forums: Microsoft Office Forums - Senior Forums