Private Sub Start()
        Dim xlAppCur As Object
        Dim xlWorkbookCur As Object
        Dim xlSheetCur As Object
        Dim vWorkDir As String, vFile As String

        xlAppCur = CreateObject("Excel.Application")
        xlAppCur.DisplayAlerts = False
        xlAppCur.Visible = False

        vWorkDir = dlgDir.SelectedPath
        vFile = Dir(vWorkDir & "\*.xls")

        Do While vFile <> ""

            xlWorkbookCur = xlAppCur.Workbooks.Open(vWorkDir & "\" & vFile, , True)
            xlSheetCur = xlWorkbookCur.Worksheets("Дополнительно")

            If Not xlSheetCur Is Nothing Then
                 If xlSheetCur.Cells( 45 ,  1 ).Value = "Номер" Then
                     txtNumber.Text = txtNumber.Text & vbCrLf & xlSheetCur.Cells( 45 ,  2 ).Value
                     txtNumber.Refresh()
                 End If
            End If

            xlSheetCur = Nothing
            xlWorkbookCur.Close()
            xlWorkbookCur = Nothing

            vFile = Dir()
        Loop
        MsgBox("Сканирование завершено.", MsgBoxStyle.Information)

        xlAppCur.Quit()
        xlAppCur = Nothing
End Sub