LEADERSOFT.ru Разработка на заказ программ и сайтов
Раздел обучения информационным технологиям
Разработка программ на Access
Для быстрой загрузки всех файлов в таблицу можно использовать этот способ. Применяйте его, например, для обработки html файлов
Свойства продукта

 Microsoft Office: 2000,2002,2003,2007,2010  Архив с файлами: Перейти
 Операционная система: Windows XP,Vista  Применение: Базы данных Access
 Продажа: Купить  Файл исходника: ..\Access\14 Файлы\la_files.mdb
 Язык интерфейса: Русский

   

' При загрузке формы загружаем файлы
Private Sub Form_Load()
    funAutoReadAllFiles Application.CurrentProject.Path, "*.txt"
End Sub


' Прочитаем имена файлов и загрузим их в таблицу
Private Sub funAutoReadAllFiles(strDir As String, strFileExt As String)
Dim As Long, rst As DAO.Recordset
On Error GoTo 999
        With Application.FileSearch
           .NewSearch
           .LookIn = strDir ' *.name
           .FILENAME = strFileExt ' *.txt
           .SearchSubFolders = False
           If .Execute(SortBy:=msoSortByFileName, _
                    SortOrder:=msoSortOrderAscending) > 0 Then
                For i = 1 To .FoundFiles.Count
                    If MsgBox("Загрузить файл: " & .FoundFiles(i), vbInformation + vbOKCancel, "Загрузить") = vbOK Then
                        funAutoReadOneFile .FoundFiles(i), "Таблица5"
                        Me.table5.Requery
                    End If
                Next i
           End If
        End With
    Exit Sub      'Выходим из программы
999:
    MsgBox Err.Description
    Err.Clear 'Очищаем поток от ошибок
End Sub


' Загружаем файл в таблицу
Private Function funAutoReadOneFile(strFileName As String, strTable)
Dim fs, f, flag
Dim dbs As DAO.Database, rst As DAO.Recordset

    On Error GoTo 999
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFile(strFileName)
    
    ' Проверка файла
    Set dbs = CurrentDb
    Set rst = dbs.OpenRecordset("select * from " & strTable)
    
    If rst.RecordCount Then
        rst.MoveLast
        rst.MoveFirst
    End If
    
    rst.FindFirst "[FileName] = '" & strFileName & "'"
    If rst.NoMatch = False Then
        dbs.Close
        rst.Close
        Exit Function
    End If
    
    ' Добавление информации о дате создания
    rst.AddNew
    rst!FILENAME = strFileName
    rst!DateCreated = f.DateCreated
    
    ' Добавление информации о содержимом
    rst!Memo = ""
    Set f = fs.OpenTextFile(strFileName, 1, False)
    Do While f.AtEndOfStream <> True
        rst!Memo = rst!Memo & f.ReadLine ' Читаем построчно
    Loop
    f.Close
    
    ' Сохранение содержимого
    rst.Update
    rst.Close
    dbs.Close
    
    Exit Function
999:
'Ошибка:
    MsgBox Err.Description
    Err.Clear
    rst.Close
End Function


Copyright © 2002-2015 ООО Лидер Эксэсс
Сайт работает под управлением: ASP.NET, Access