Автозагрузка файлов в таблицу |
|
|
Для быстрой загрузки всех файлов в таблицу можно использовать этот способ. Применяйте его, например, для обработки 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 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