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
|