MyTetra Share
Делитесь знаниями!
Код VBA для импорта данных из текстового файла
Время создания: 16.03.2019 23:43
Текстовые метки: vba_access, импорт из текста
Раздел: Разные закладки - VBA - Access
Запись: xintrea/mytetra_db_adgaver_new/master/base/14839648521hyvj2z8yq/text.html на raw.githubusercontent.com

Код VBA для импорта данных из текстового файла

  'объявляем переменные

  Dim str As String

  Dim str1 As String

  Dim str2 As String

  Dim str3 As String

  Dim rs As ADODB.Recordset

  Dim FileDialog As FileDialog

  Dim path  As String

  'Создаем диалоговое окно выбора файла

  Set FileDialog = Application.FileDialog(msoFileDialogOpen)

  'Убираем множественный выбор

  FileDialog.AllowMultiSelect = False

  FileDialog.Filters.Clear

  'Добавим фильтр

  FileDialog.Filters.add "Текстовые файлы", "*.txt"

  FileDialog.FilterIndex = 1

  'проверяем, выбрал файл или нет

  If FileDialog.Show = False Then

     Set FileDialog = Nothing

     Exit Sub

  End If

  'путь к файлу

  path = Trim(FileDialog.SelectedItems(1))

  'очищаем переменную с объектом

  Set FileDialog = Nothing

  If path <> "" Then

  'Открываем файл

  Open path For Input As #1

  'циклом считываем все данные построчно

  Do While Not EOF(1)

      Line Input #1, str

       If Mid(str, 1, InStr(str, "=")) = "Строка1=" Then

            str1 = Mid(str, InStr(str, "=") + 1)

        End If

       If Mid(str, 1, InStr(str, "=")) = "Строка2=" Then

            str2 = Mid(str, InStr(str, "=") + 1)

        End If

    If Mid(str, 1, InStr(str, "=")) = "Строка3=" Then

            str3 = Mid(str, InStr(str, "=") + 1)

        End If

    'Если встречаем "Конец" то записываем в базу

    If str = "Конец" Then

    'Создаем рекордсет

        Set rs = New ADODB.Recordset

    'Открываем таблицу

        rs.open "test_import", CurrentProject.Connection, adOpenDynamic, adLockOptimistic

    'Записываем данные

    With rs

        .AddNew

        .Fields("str1") = str1

        .Fields("str2") = str2

        .Fields("str3") = str3

        .Update

    End With

    End If

    Loop

    'Закрываем файл

  Close #1

  'Просто сообщение

  MsgBox "Загружено"

  End If

 

Так же в этом разделе:
 
MyTetra Share v.0.62
Яндекс индекс цитирования