Option Compare Database

Dim id As Integer
Dim area As Integer
Dim cnn As ADODB.Connection
Dim rst As New ADODB.Recordset
Dim dtTotal As Integer
Dim dtIncom As Integer

Public Sub ListFilesReload()
Dim i As Integer

For i =  1  To Список10.ListCount
   Список10.RemoveItem ( 0 )
Next i

With Application.FileSearch
    .NewSearch
    .LookIn =  "o:\iii\"  'Директория с файлами'
    .SearchSubFolders = False
    .FileName =  "*.*" 
    .MatchTextExactly = True
End With
With Application.FileSearch
    If .Execute() >  0  Then
        For i =  1  To .FoundFiles.Count
        Список10.AddItem Item:=Replace(.FoundFiles.Item(i),  "c:\windows\" ,  "")
        Next i
    End If
End With
Call xxx
End Sub

Private Sub Кнопка20_Click()
   Call ListFilesReload 'Это и есть запуск всей функции'
End Sub

Public Function xxx()

Set cnn = CurrentProject.Connection
rst.Open " Таблица1 ", cnn, adOpenKeyset, adLockPessimistic

For i = 0  To Список10.ListCount -  1 
   With rst
      .AddNew
      !id = DMax("id ", " Таблица1 ") + 1 
      !fldTime = dtDate(Список10.ItemData(i))
      FileProcess (Список10.ItemData(i))
      !area = Mid(Список10.ItemData(i), Len(Список10.ItemData(i)) -  11 ,  4 )
      !total = dtTotal
      !incom = dtIncom
      .Update
   End With
Next i

End Function



Public Function dtDate(FileName As String) As Date

   dtDate = DateSerial(Mid(FileName, Len(FileName) -  19 ,  4 ), Mid(FileName, Len(FileName) -  15 ,  2 ), Mid(FileName, Len(FileName) -  13 ,  2 )) _
& " " & TimeSerial(Mid(FileName, Len(FileName) -  7 ,  2 ), Mid(FileName, Len(FileName) -  5 ,  2 ),  0 )

End Function



Private Function FileProcess(ByVal FName As String)

Dim FHandle As Integer, GetStr As String
FHandle = FreeFile
Open FName For Input As FHandle
Do Until EOF(FHandle)
Line Input #FHandle, GetStr

   dtTotal = Left(GetStr,  4 )
   dtIncom = Right(GetStr,  2 )

Loop
Close FHandle

End Function