Программирование на Visual Basic | Microsoft Access. Автозагрузка файлов в таблицу

В этом разделе сайта находятся примеры из сборника программ "Архив файлов на Microsoft Access". В нем рассказывается о программировании форм, отчетов, таблиц и других объектов. Используйте этот архив для изучения работы с приложением Microsoft Office Access и программированием на Visual Basic for Application. Тем кто уже знаком с VBA, используйте поиск для нахождения кодов. Наберите, например, DAO, ADO, Recordset и найдете нужную ссылку для решения проблемы с программированием

Microsoft Access. Автозагрузка файлов в таблицу

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

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

' Прочитаем имена файлов и загрузим их в таблицу
Private Sub funAutoReadAllFiles(strDir As String, strFileExt As String)
Dim i 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

Добавить комментарий

Loading