Вот пример удаления-создания связей. Может уже апаздал, но мало ли

Тоска уйдет, сомнений нет.
Вот только будет ли ответ?
В глазах песок, в мозгу туман,
Тут нужен видимо стакан.

Давай развею Вам тоску
Забъю задачею "башку"
Коль думой занята башка
Уйдёт сама собой тоска

Как показывает моя небольшая практика, исчезают обычно модули (особенно форм), в которых ошибки в коде (причем зачастую банальные типа If без End IF). Стал писать чуть внимательнее, глюков стало значительно меньше.

А делать нечего пока.
В душе унылая тоска.

Кстати об исчезновениях ...
Тока что пытался проверить базу доктором Access
База исчезла без следа - хорошо в раре сжата копия.
А на той неделе труд целого дня - просто исчез - модуль в базе был, закрыл открыл и модуль сплыл.
"Чудеса глюкозные"

Вот и я удивлён....
Зима располагает к спячке
А Вы с утра в инетной скачке.....

На форуме SQL.ru, периодически народ жалуется на исчезновение файла при программном (и автоматическом, когда установлена опция сжимать при закрытии) сжатии.
Выполнять команду вручную на сжатие (после создания резервной копии) из интерфейса Access-а надежнее. Вот.

При программном сжатии может получиться конфуз. Я всегда лапками сжимаю

Вы что-то имеете ввиду !!!

Сжимать не обязательно, наверное. Хотя если пересылать по почте, можно сжать и засунуть в архив.
При программном сжатии может получиться конфуз. Я всегда лапками сжимаю.

Что - то не спалось сегодня, обычно раньше 12 меня из пушки не разбудить.

И так чего получается

1. Создать программно базу.
2.Создаь программно таблицы 1 и 2
3. Перебросить данные в аблицы 1 и 2
4. Сжать базу.

А ведь у мня щас первые два-три пункта решаются копированием базы.
одной строкой кода
Filecopy a,b

Ты уже не спишь???????
Ты как железный - ночью ещё не спишь, а утром уже не спишь.

Сходил , я , глянул......

http://am.rusimport.ru/MSAccess/topic.aspx?ID=462

А полей как видно отсюда два:
SELECT ItemName, ItemValue

...структура может поменяться (количество и нааименование полей)...
А это можно предварительно считывать из оригинала.

Хорошо, что пашет, кто бы усомнился, чтоб у тебя не похало, - тому в оахало!!!
.....
Это вы одно поле перебрасываете.?
А создать пустую базу - программно это как?
А таблицы там создать - это как ?-
структура может поменяться (количество и нааименование полей)

Попробовал, пашет:

INSERT INTO tblItem IN 'C:\Documents and Settings\Lukas\Рабочий стол\БазаНовая.mdb' SELECT ItemName, ItemValue FROM tblItem IN 'C:\Documents and Settings\Lukas\Рабочий стол\БазаДанных.mdb' WHERE IDItem Between 5 AND 8;

Запускаю запрос на выполнение в третьей базе.

А что если сделать два запроса:
INSERT (в новый файл) ... SELECT FROM (из файла базы данных) WHERE (наши условия)?

Нет,
я их линкую по мере необходимости.
А эта "база" для обслуживания основной.
"техническая такая"

Нужные таблицы из третьей базы прилинкованы к текущей?

Ну так создаем новый файл, экспортируем в него таблицы (без данных) из текущей бд
Данные лежат в третьей базе.
Потому её сразу и копируем (создавая новый файл сразу с таблицами нужных структур)
рвём связи
В таблицах удалям ненужное
И сжимаем программно

Ну так создаем новый файл, экспортируем в него таблицы (без данных) из текущей бд, экспортируем данные.

Ты всё понял правильно!!!!

СТруктура везде одинаковая

Две таблицы нужны, насколько я понял в файле обмена?
А структура таблиц как в текущей базе или в другой?

Можно и с нуля, но видимо это редьки не слаще.......

Так может файл обмена создавать с нуля, а не копировать?

Ваще-то
Вот чё я творю

Private Sub Кнопка4_Click()  Dim Of As String  Dim OTPRAVKA As String Of = Nz(DFirst("OFISA", "PUTI")) If Of = "" Then Call MsgBox("Не установлен префикс офиса" _             & vbCrLf & "Выгрузку производить нельзя!!!!!!!!!!!!!" _             , vbCritical, "Предупреждение ") Exit Sub End If If Of = "ZAVOD" Then Call MsgBox("Установлен префикс центрального офиса" _             & vbCrLf & "Выгрузку производить нельзя!!!!!!!!!!!!!" _             , vbCritical, "Предупреждение ") Exit Sub End If          If MsgBox("Выгружаем данные за " & Me!Поле97 & " ГОД ?", vbYesNo) = vbNo Then MsgBox "ВЫБЕРИТЕ НУЖНЫЙ ГОД ": Exit Sub     PutTablic = Nz(DFirst("PutTablic", "PUTI"))     If CheckDir(PutTablic & "\BAZA" & Me![Поле97] & ".mdb") = False Then     Call MsgBox("Не обнаружен путь к основной таблице -> kas" & Me!Поле97, vbCritical, "Предупреждение.")     Call MsgBox("Укажите папку расположения таблиц.", vbQuestion, "Сообщение.")     PutTablic = FileUtils_GetFolderName     If Nz(PutTablic) = "" Then     DoCmd.Close acForm, Me.Name     Quit     End If     Exit Sub     End If   If Zanato(PutTablic & "\BAZA" & Me!Поле97 & ".mdb") = True Then Exit Sub    PutObmena = Nz(DFirst("PutObmena", "PUTI"))            Obmen = PutObmena & "\Obmen" & Me!Поле97 & ".mdb"            OTPRAVKA = PutObmena & "\OTPRAVKA" & Me!Поле97 & ".mdb"          If CheckDir(Obmen) = True Then         Kill Obmen         End If             FileCopy PutTablic & "\BAZA" & Me!Поле97 & ".mdb", Obmen Call DeleteAllRelations(Obmen)         Call LinkTabNewName(Obmen, "kas" & Me!Поле97, "kas_osnovna")         Call LinkTabNewName(Obmen, "dog" & Me!Поле97, "dog_osnovna")         If Nalichie_Tablici("kas_osnovna") = True Then     ' Удалить записи из таблицы kas с Ofis создания не равной местному DoCmd.OpenQuery "Udalenie_V_Obmene_KAS"    ' Удалить записи из таблицы kas с датой создания не равной периоду DoCmd.OpenQuery "Udalenie_V_Obmene_DOG"         End If          Call DeleteTableName("kas_osnovna") Call DeleteTableName("dog_osnovna")         If CheckDir(OTPRAVKA) = True Then         Kill OTPRAVKA         End If         DBEngine.CompactDatabase Obmen, OTPRAVKA                  If CheckDir(OTPRAVKA) = True Then         MsgBox "СОЗДАН файл обмена с основным офисом " & OTPRAVKA         End If End Sub

Хорошо тебе!!!!!!

А у меня не видно.

Кратковременно появляется пустое серое
окно Access .

Надо как-то видимо VISIBLe

"НАКЛАДОЧКА"
Какая?

Кудыж правильнее?
Связи рвуться...........
Есть правда
"НАКЛАДОЧКА"

Да не на чем.
Может завтра кто более правильное решение подкинет.

ДА, Lukas - твой код рабочий!!!!
А у меня какая - то ХР , а не код...............

Хорошо, что хоть у тебя всё рабочее получается, а то ба мне кирдык.
Спасибо тебе!!!!

Возьмите мой кусок, он рабочий.

А может вообще надо средствами библиотек ADOX, DAO ?

А у мня ругается .....
скотина......

Dim appAccess As Access.Application Set appAccess = New Access.Application With appAccess.CurrentDb  .OpenCurrentDatabase Obmen .Relations.Delete .Relations(0)  .CloseCurrentDatabase End With Set appAccess = Nothing

Вот полный код:

Public Sub DeleteAllRelations(strFileDBName As String)     Dim appAccess As Object     Set appAccess = CreateObject("Access.Application")     appAccess.OpenCurrentDatabase strFileDBName, True     With appAccess.CurrentDb         Do While .Relations.Count > 0             .Relations.Delete .Relations(0).Name         Loop     End With     appAccess.CloseCurrentDatabase     appAccess.DoCmd.Quit     Set appAccess = Nothing End Sub

Так CurrentDb у нас будет открываться в объекте appAccess, а не в Application
И в строке

With appAccess.CurrentDb

мы работаем с CurrentDb объекта appAccess, а не Application
А поможет точно, я попробовал.

Вы думаете мопожет?
мне же во внешней базе надо рвать
тода .OpenCurrentDatabase Obmen не корректно

Поправка:

With appAccess.CurrentDb

Я просто перепошутил.
Связь тама одна
Таблиц две
Не ошибусь

Говорят - метот нот фоунд
.Relations

У людей сомненья какую связь правильно создать, а он их рвет все подряд без разбора. Ужос.

Спасибо огромное
Пробую РВАТЬ И метать..............

Говорят - метот нот фоунд

Еще один вариант, самый(единственно) правильный

With appAccess         Do While .Relations.Count > 0             .Relations.Delete .Relations(0).Name         Loop     End With

Первый вариант рабочий, а второй пока нет.

Возможно, так правильнее:

Dim i As Integer     For i = 0 To appAccess.Relations.Count - 1         appAccess.Relations.Delete appAccess.Relations(i).Name     Next i

Вот только не знаю как коллекция Relations нумеруется, с 0 или с 1

Dim rel As Relation     For Each rel In appAccess.Relations         appAccess.Relations.Delete rel.Name     Next rel

Dim appAccess As Access.Application
Set appAccess = New Access.Application
With appAccess
.OpenCurrentDatabase Obmen
.как порвать всё?
.CloseCurrentDatabase
End With
Set appAccess = Nothing

With appAccess .Relations.Delete strRelationName End With

пробываю!!!
А что это за оператор (Здесь рвем связь)
Я раньше программно их не рвал
И даже приближонно не знаю как это реализовать и в текущеё то базе, а тут замахнулся на внешнюю

Может как -то так.
strFileDBName-Путь к изменяемой базе.
Открываем ее как текущую:

Set appAccess = CreateObject("Access.Application")     appAccess.OpenCurrentDatabase strFileDBName, True ...Здесь рвем связь     appAccess.CloseCurrentDatabase     appAccess.DoCmd.Quit     Set appAccess = Nothing

Мне бы разорвать звязь между таблицами в другой базе из текущей программно.

currentdb.Relations и т.д.

Имеется база ххх . mdb
в ней две таблицы - DOG и KAS - связь один ко многим
Вопрос:
Как из другой базы zzz.mdb ,
программно,
разорвать звязь между таблицами в базе ххх . mdb