powered by simpleCommunicator - 2.0.55     © 2025 Programmizd 02
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Форумы / Microsoft Access [игнор отключен] [закрыт для гостей] / Переброс данных из другой базы
3 сообщений из 28, страница 2 из 2
Переброс данных из другой базы
    #39315680
Фотография час58
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
час58,

СпС

Спасибо час58, всё заработало.
...
Рейтинг: 0 / 0
Переброс данных из другой базы
    #39315698
Фотография час58
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Всем спасибо за помощь.
Код работает как часы.
В доли секунды.
Вот окончательный вариант.
Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
Private Sub ZAGRUZKA_SPRAVOCHNIKOV_BTN_Click()
' из другой азы зарузка данных CLN_TBL.mdb
    Dim tdf As DAO.TableDef
    ' Dim BD_1 As DAO.Database ' текущая база
    Dim BD_2 As DAO.Database    ' другая база
    Dim Table_Name As String '
    Dim Pole_Name As String  '
    Dim RST_1 As DAO.Recordset
    Dim RST_2 As DAO.Recordset
    Dim Stroka_Pole_Name As String
    Dim Stroka_SQL As String

   On Error GoTo ZAGRUZKA_SPRAVOCHNIKOV_BTN_Click_Error '--------------------------------------

    If VOPROS("Удалить все имеющиеся данные?") = False Then Exit Sub
    If VOPROS("Заменить все данные справочников?") = False Then Exit Sub
    MESS "Укажите путь к файлу таблиц для загрузки данных"
    STR_FILTER = "Выберите файл" & Chr$(0) & "*.mdb" & Chr$(0)
    TEMP_PATCH_TO_BASE = FileOpenSave(OFN_OVERWRITEPROMPT, CurrentProject.Path, STR_FILTER, , ".mdb", , "Выбор CLN_TBL.mdb", -1, True)

    If Nz(TEMP_PATCH_TO_BASE) <> "" Then
        If InStr(1, TEMP_PATCH_TO_BASE, "CLN_TBL", vbTextCompare) <> 0 Then
            '            Set BD_1 = CurrentDb   '
            Set BD_2 = OpenDatabase(TEMP_PATCH_TO_BASE)    ' путь к базе указанный пользователем
            For Each tdf In BD_2.TableDefs
                If Mid(tdf.Name, 1, 4) <> "Msys" Then   'если  не системная таблица тогда смотрим

                    Table_Name = tdf.Name
                    If Table_Name = "LANGUAGE_TBL" Then GoTo DALEE
                    If Table_Name = "SPR_MONTH_TBL" Then GoTo DALEE
                    If Table_Name = "Ошибки вставки" Then GoTo DALEE
                    ' очистка таблицы
                    CurrentDb.Execute "DELETE FROM " & Table_Name
                    Set RST_2 = BD_2.OpenRecordset(Table_Name, dbOpenDynaset)
                    If RST_2.RecordCount <> 0 Then
                        RST_2.MoveLast
                        RST_2.MoveFirst
                        Stroka_Pole_Name = ""

                        For Each objField In BD_2.TableDefs(tdf.Name).Fields
                            Pole_Name = objField.Name
                            '                If Nz(Pole_Name) = "Код" Then GoTo dalee_1
                            If Stroka_Pole_Name = "" Then
                                Stroka_Pole_Name = Stroka_Pole_Name & Pole_Name
                            Else
                                Stroka_Pole_Name = Stroka_Pole_Name & ", " & Pole_Name
                            End If
dalee_1:
                        Next
                        Debug.Print Stroka_Pole_Name
                        If Stroka_Pole_Name <> "" Then
                            Stroka_SQL = "INSERT INTO " & Table_Name & " (" & Stroka_Pole_Name & ") SELECT " & Stroka_Pole_Name & " FROM  " & Table_Name & " IN '" & TEMP_PATCH_TO_BASE & "'"
                            DoCmd.SetWarnings False
                            DoCmd.RunSQL Stroka_SQL
                            DoCmd.SetWarnings True
                        End If
                    End If
                End If
DALEE:
            Next tdf
            
            BD_2.Close
            Set BD_2 = Nothing
            MESS "Готово."
            Me.Requery
        Else
            MESS "Не верно указан файл."
            Exit Sub
        End If
    Else
        MESS "Не указан файл."
        Exit Sub
    End If

 '----------------------------------------------------------------------------
   On Error GoTo 0
   Exit Sub

ZAGRUZKA_SPRAVOCHNIKOV_BTN_Click_Error:
    Call ZAPIS_V_TEXT_FILE(CurrentProject.Path & "\Ошибки программы.txt", " функция: ZAGRUZKA_SPRAVOCHNIKOV_BTN_Click в модуле: Form_TUNING_FRM" & vbTab & Nz(Err.Description))


End Sub




Хорошо бы проверить на большом количестве данных.
...
Рейтинг: 0 / 0
Переброс данных из другой базы
    #39316256
Фотография час58
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Процедурка получилась универсальной.
Загружать данные из сохранившегося файла данных для восстановления, если даже в новом файле структура таблиц несколько отличается от структуры таблиц загружаемого файла. То есть добавлено несколько новых полей, но и, не удалены старые поля.
С её помощью можно восстанавливать данные из архивных файлов.
...
Рейтинг: 0 / 0
3 сообщений из 28, страница 2 из 2
Форумы / Microsoft Access [игнор отключен] [закрыт для гостей] / Переброс данных из другой базы
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]