Private m_strWorksheetNames As String
Private m_strSheetDetails() As SheetDetails
'// Spreadsheet information.
Public Type SheetDetails
   InvDate As Date
   CustID As String
   InvNum As String
   Description As String
End Type

Private Sub lvbProcess_Click()
   '// Process the spreadsheet and import into Accpac.
   
   Dim rs As ADODB.Recordset
   Dim Conn As ADODB.Connection
   Dim i As Integer
   Dim j As Integer
   Dim k As Integer
   Dim l_strSheetNamesArr() As String
   
   On Error GoTo ERR_Handler
   
   Get_WorksheetNames
   
   Set rs = New ADODB.Recordset
   Set Conn = New ADODB.Connection
   Conn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Trim$(pzeSource.Text) & ";Extended Properties=Excel 8.0;Persist Security Info=False"
   'Conn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Trim$(pzeSource.Text) & ";Extended Properties=Excel 8.0;IMEX=1"
   Conn.ConnectionTimeout = 40
   Conn.Open
   
   l_strSheetNamesArr = Split(m_strWorksheetNames, "|")
   For i = 0 To UBound(l_strSheetNamesArr)
   
      rs.Open "SELECT * FROM [" & l_strSheetNamesArr(i) & "$]", Conn, adOpenStatic, adLockOptimistic
      If Not (rs.BOF And rs.EOF) Then
         rs.MoveFirst
         
         Erase m_strSheetDetails
         
         '// Iterate through the rows.
         For j = 0 To rs.RecordCount - 1
            '// Iterate through the columns.
            For k = 0 To rs.Fields.Count - 1

               If IsDate(rs.Fields(k).Value) Then
                  If ArrayHasElements(ArrPtr(m_strSheetDetails())) Then
                     ReDim Preserve m_strSheetDetails(UBound(m_strSheetDetails) + 1) As SheetDetails
                  Else
                     ReDim m_strSheetDetails(0) As SheetDetails
                  End If
               
                  m_strSheetDetails(UBound(m_strSheetDetails)).InvDate = rs.Fields(k).Value

                  '// This entry is sometimes blank.
                  m_strSheetDetails(UBound(m_strSheetDetails)).CustID = rs.Fields(k + 1).Value
                  m_strSheetDetails(UBound(m_strSheetDetails)).InvNum = rs.Fields(k + 2).Value
                  m_strSheetDetails(UBound(m_strSheetDetails)).Description = rs.Fields(k + 3).Value
                  
                  Exit For
               End If
            Next k
            rs.MoveNext
         Next j
      End If
   Next i
   Exit Sub
    
ERR_Handler:
   If Err.Number = 94 Then    '// Invalid use of Null.
      Resume Next
   Else
      ErrorMessenger Err.Number, Err.Description, "lvbProcess_Click"
   End If
End Sub

Private Sub Get_WorksheetNames()
'// Worksheet may have multiple tabs.
    Dim objExcel As Excel.Application
    Dim objWorkBook As Excel.Workbook
    Dim totalWorkSheets As Excel.Worksheet
    Dim objWorkSheets As Excel.Worksheet
    'Dim ExcelSheetName As String

    Set objExcel = CreateObject("Excel.Application")
    Set objWorkBook = objExcel.Workbooks.Open(pzeSource.Text)

    ' this code gets the names off all the worksheets
    For Each totalWorkSheets In objExcel.ActiveWorkbook.Worksheets
      'ExcelSheetName = totalWorkSheets.Name
      If Trim$(m_strWorksheetNames) = "" Then
         m_strWorksheetNames = totalWorkSheets.Name
      Else
         m_strWorksheetNames = m_strWorksheetNames & "|" & totalWorkSheets.Name
      End If
    Next totalWorkSheets
    
    objWorkBook.Close
    objExcel.Quit
End Sub