Форум программистов, компьютерный форум, киберфорум
Наши страницы
MS Access
Войти
Регистрация
Восстановить пароль
 
Statheros
0 / 0 / 0
Регистрация: 24.08.2017
Сообщений: 62
1

Сжатие базы данных по варианту 6.4. из темы Написание статей

22.02.2018, 14:18. Просмотров 349. Ответов 13
Метки нет (Все метки)

Выполнил все рекомендации изложенные в пункте 6.4.. На последнем этапе застрял.

Цитата Сообщение от БурундукЪ Посмотреть сообщение
- откройте базу, из которой будет вызываться созданный нами "Провайдер Обслуживания БД", и добавьте в соответствующее место (например, на кнопку "Выход", или на событие выгрузки главной формы проекта) код:
[/VB] * Shell "C:\Program Files\Microsoft Office\Office\Msaccess.exe " & _
* * """C:\Тест\DBServiceProvaider.mdb""", vbMaximizedFocus
* DoCmd.Quit [/VB]
Обратите внимание, что сначала указывается полный путь к исполнимому файлу Access, а затем полный путь к созданной "DBServiceProvaider.mdb", при этом как тот, так и другой необходимо указать в соответствии с расположением файлов на машине.
Короче, не сжимается база. Причем созданный мною провайдер рабочий. Если его вручную запустить база сжимается успешно.

Процитированный выше код я немного изменил. Хотелось мне автоматизировать процесс подключения к Провайдеру Обслуживания БД, лень каждый раз пути прописывать при последующем использовании кода.

Visual Basic
1
2
  Shell SysCmd(acSysCmdAccessDir) & "msaccess.exe" & _
    "'" & CurrentPath() & "\" & DBServiceProvaider.accdb & "'", vbMaximizedFocus
CurrentPath() - рабочий каталог где лежит база и файл Провайдера Обслуживания БД

Visual Basic
1
2
3
4
5
Public Function CurrentPath() As String 'рабочий каталог 
Dim strName As String
strName = CurrentDb.Name
CurrentPath = Left(strName, Len(strName) - Len(Dir(strName)) - 1)
End Function


Аксесс пишет "Run-time error '424'. Obiect required". Не пойму какой из них требуется?
Пробовал ссылки вписывать тоже ошибка. "Run-time error '53'. File not found". Какой из двух файлов?
Может дело в версии Аксесс? У меня 2016. Провайдеры создал mdb и accdb оба рабочие.
0
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
22.02.2018, 14:18
Ответы с готовыми решениями:

Сжатие базы данных
Здравствуйте! Подскажите: почему создав базу данных в Access 2010 с расширением...

Програмное сжатие базы данных.
Вопрос как по VBA или VB сделать, чтобы база lfyys[(*.mdb 2002) ужалась. Есть в...

Сжатие базы данных из внешнего приложения, продолжение.
Спрашивал, я тут на днях. Программирую С++Builder 5, добавил библиотеку JPO и...

Написание статей
В чём проблема MS Access не предоставляет нам возможности выбора способа...

Вывод статей(данных с базы)
Делаю вывод статей с БД. Когда нахожусь на posts все ок, статьи видно, когда...

13
Capi
1727 / 916 / 182
Регистрация: 12.06.2016
Сообщений: 2,005
22.02.2018, 14:43 2
Цитата Сообщение от Statheros Посмотреть сообщение
Shell SysCmd(acSysCmdAccessDir) & "msaccess.exe"
пробела нет в конце "msaccess.exe" - "msaccess.exe ".

Добавлено через 7 минут
Цитата Сообщение от Statheros Посмотреть сообщение
"" & DBServiceProvaider.accdb & "'"
Кроме того, эта часть должна быть такой: "\DBServiceProvaider.accdb'"
1
Eugene-LS
Эксперт MS Access
3443 / 1875 / 347
Регистрация: 05.10.2016
Сообщений: 5,164
22.02.2018, 14:44 3
Statheros, вместо функции CurrentPath() - вполне должно подойти:
Visual Basic
1
    CurrentProject.Path  ' = Полный путь к папке текущего приложения (без слеша на конце)
1
Capi
1727 / 916 / 182
Регистрация: 12.06.2016
Сообщений: 2,005
22.02.2018, 14:46 4
То есть, в целом,
Visual Basic
1
Shell SysCmd(acSysCmdAccessDir) & "msaccess.exe '" & CurrentPath() & "\DBServiceProvaider.accdb'", vbMaximizedFocus
1
Statheros
0 / 0 / 0
Регистрация: 24.08.2017
Сообщений: 62
22.02.2018, 15:31  [ТС] 5
Спасибо за оперативные ответы. Теперь Аксесс запускается, но ругается: "Командная строка для запуска приложения Аксесс содержит неизвестный параметр...". В финале Аксесс сообщает что не удается найти файл базы данных.
0
amd48
390 / 132 / 20
Регистрация: 18.05.2016
Сообщений: 353
Записей в блоге: 1
22.02.2018, 15:47 6
Создайте строковую переменную. Присвойте ей то выражение, которое идёт в параметре у Shell. Перед строкой с Shell добавьте строку
Debug.Print переменная
запустите процедуру и посмотрите в окне Immediate (можно открыть по Ctrl+G) получившуюся строку. В ней должно быть:
"путь_к_msaccess.exe" "путь_к_базе.accdb" /compact
Если не будет хватать каких-то кавычек или пробелов - там и копайте
2
Eugene-LS
Эксперт MS Access
3443 / 1875 / 347
Регистрация: 05.10.2016
Сообщений: 5,164
22.02.2018, 16:13 7
Цитата Сообщение от amd48 Посмотреть сообщение
Создайте строковую переменную. Присвойте ей то выражение, которое идёт в параметре у Shell.
...
Точно!
Что-то вроде этого:
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
Sub test()
Dim s$, s01$, s02$
    s01 = """" & SysCmd(acSysCmdAccessDir) & "msaccess.exe"""
    Debug.Print s01
    s02 = """" & CurrentProject.path & "\DBServiceProvaider."""
    Debug.Print s02
    
    s = s01 & " " & s02 & " /compact"
    Debug.Print s
'Поехали! ...
    Shell s, vbMaximizedFocus
End Sub
Надеюсь что с кавычками всё понятно.
0
Statheros
0 / 0 / 0
Регистрация: 24.08.2017
Сообщений: 62
22.02.2018, 16:20  [ТС] 8
amd48, сделал как Вы написали. В итоге окно Immediate показало точные пути к Аксессу и файлу Провайдера.

C:\Program Files (x86)\Microsoft Office\Office16\msaccess.exe 'C:\Users\Константин\Documents\База\DBServiceProvaider.mdb'
Почему Аксесс ругается и не работает не понятно...
0
Eugene-LS
Эксперт MS Access
3443 / 1875 / 347
Регистрация: 05.10.2016
Сообщений: 5,164
22.02.2018, 16:25 9
Цитата Сообщение от Statheros Посмотреть сообщение
Почему Аксесс ругается и не работает не понятно...
Кавычки не те!!!
Должно быть так:
Visual Basic
1
"C:\Program Files (x86)\Microsoft Office\Office14\msaccess.exe" "D:\AProjects\DB Test\DBServiceProvaider.mdb" /compact
Пожалуйста смотрите мой сабж выше (#7)
Только там:
s02 = """" & CurrentProject.path & "\DBServiceProvaider."""
Следует заменить на :
s02 = """" & CurrentProject.path & "\DBServiceProvaider.mdb"""

Не углядел малость - ссори!

только что проверил:
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Sub test()
Dim s$, s01$, s02$
    s01 = """" & SysCmd(acSysCmdAccessDir) & "msaccess.exe"""
    Debug.Print s01
    
    's02 = """" & CurrentProject.path & "\DBServiceProvaider.mdb"""
    или так:
    s02 = """d:\Temp\Database_v03.accdb"""
    Debug.Print s02
    
    s = s01 & " " & s02 & " /compact"
    Debug.Print s
'Поехали ...
    Shell s, vbMaximizedFocus
End Sub
Отработало!
0
Statheros
0 / 0 / 0
Регистрация: 24.08.2017
Сообщений: 62
22.02.2018, 16:53  [ТС] 10
Eugene-LS, спасибо у меня тоже сработало. Пути показывает в кавычках. Видно с я ними напортачил. Как теперь из этого теста работоспособный код написать? Уж в глазах рябит от этих кавычек)))
0
amd48
390 / 132 / 20
Регистрация: 18.05.2016
Сообщений: 353
Записей в блоге: 1
22.02.2018, 18:50 11
я пользуюсь таким:
vb.net
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Sub CompactDatabase()
Dim strPathToMDB As String, f As Form
Dim iSizeBefore As Long, iSizeAfter As Long
Dim t As TableDef
For Each t In CurrentDb.TableDefs
    If t.Connect <> "" Then     'ищем первую попавшуюся внешнюю таблицу, чтоб взять её Connect
        strPathToMDB = Mid(t.Connect, Len(";DATABASE=") + 1)
        iSizeBefore = FileLen(strPathToMDB) / 1024  'замеряем разбер базы перед сжатием
        For Each f In Forms                         'закрываем все формы
            DoCmd.Close acForm, f.Name
        Next
        Dim sh As Variant
        Set sh = CreateObject("WScript.Shell")
        sh.Run "cmd /c msaccess.exe " & strPathToMDB & " /compact", 1, -1 'сжимаем
        iSizeAfter = FileLen(strPathToMDB) / 1024   'замеряем базу после сжатия
        MsgBox strPathToMDB & vbCrLf & "До сжатия " & iSizeBefore & " Mb" & vbCrLf & _
           "после сжатия " & iSizeAfter & " Mb", vbInformation, "Сжатие базы"
        Exit For
    End If
Next
End Sub
1
Statheros
0 / 0 / 0
Регистрация: 24.08.2017
Сообщений: 62
05.07.2018, 11:30  [ТС] 12
Написал я согласно вышеназванному пункту 6.4. статьи "Сжатие базы данных" код сжатия базы данных. Все работает...

Так как при относительной готовности базы данных затягивает полученный комфорт в выполнении работы, снижается время на ее выполнение - веди только базу, а нужные документы сформируются по нажатию кнопки. Начал делать базу для новых задач. Поэтому вернулся к сжатию баз данных.
Появилось желание использовать Провайдер обслуживания в разных базах без переписывания кода также подвигло сделать так чтобы при первом запуске сжатия открывалось окно выбора файлов Базы данных, выбранные пути потом помещались в те места кода, где нужно их прописывать вручную.

Например:
Visual Basic
1
2
3
4
  Case 0    'Первый шаг "Обслуживания БД"'
    Call gsTryToCompactDB("C:\Тест\MyDB1.mdb")
  Case 1    'Второй шаг "Обслуживания БД"'
    Call gsTryToCompactDB("C:\Тест\MyDB2.mdb")
В общем что-то не очень получается. Вышеобсужденная проблема вызова Провайдера из сжимаемой базы решена. Теперь проблема с самим провайдером. Чтобы минимизировать ошибки решил, что при запуске провайдера будет сверяться занесенный в провайдер путь с реальным расположением файла. Если совпадают, запускается сжатие. Если по указанному пути фалов нет, то открывается окно выбора файла. Также если путей в базе нет - первый запуск, тоже открывается окно выбора. Здесь повалились косяки... Получилось три условия. Постоянно ошибки выскакивают. SELECT и DLookup при пустой таблице не работают, сделал невидимую форму с полями. Вроде настроил условие на отсутствие значения, запускаю, срабатывает, открывается окно, выбираю файлы... Опять ошибка, теперь ругается на условие на отсутствие значения, так как поля заполнены, почему-то не срабатывает следующее условие... Наверное мои косяки для многих элементарны. Прошу понять и простить))). Я Аксесс изучаю на основе примеров. В общем и не думал заниматься этим постоянно. Думаю автоматизирую одну задачу и хватит с меня. А тут поперло еще две базы начал делать...
Код проверяющей функции
Кликните здесь для просмотра всего текста
Visual Basic
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
Function funStartLink()
Dim s01 As String
Dim s02 As String
Dim InterfaceDb As String
Dim DataDb As String
Dim DlgUser1%
Dim DlgUser2%
Dim DlgUser3%
 
'При первом запуске указываем пути к файлам Базы данных
If IsNull(Me.InterfaceDb) Or (Me.DataDb) Then
       DlgUser1 = MsgBox("Для продолжения работы необходимо указать путь к файлам Базы данных и ее интерфейса!", _
                 vbOKOnly + vbCritical, "Внимание!")
                       If DlgUser1 = vbOK Then
                              DoCmd.OpenForm "frmLocalInstAdmin"
                       End If
ElseIf Not IsNull(Me.InterfaceDb) And (Me.DataDb) Then
    'Проверяем наличие Интерфейса и Базы данных
    s01 = Dir(Me.InterfaceDb)
    s02 = Dir(Me.DataDb)
    If s01 <> Me.InterfaceDb Then
          DlgUser2 = MsgBox("База данных или ее интерфейс не подключены к Провайдеру обслуживания." _
                     & Chr(13) & Chr(10) & "Для продолжения работы необходимо обновить путь к файлам Базы данных и ее интерфейса!", _
                     vbOKOnly + vbCritical, "Внимание!")
                       If DlgUser2 = vbOK Then
                              DoCmd.OpenForm "frmLocalInstAdmin"
                              Exit Function
                       End If
                    
    End If
    If s02 <> Me.DataDb Then
          DlgUser3 = MsgBox("База данных или ее интерфейс не подключены к Провайдеру обслуживания." _
                     & Chr(13) & Chr(10) & "Для продолжения работы необходимо обновить путь к файлам Базы данных и ее интерфейса!", _
                     vbOKOnly + vbCritical, "Внимание!")
                       If DlgUser3 = vbOK Then
                              DoCmd.OpenForm "frmLocalInstAdmin"
                              Exit Function
                       End If
    End If
Else
 
DoCmd.OpenForm "frmLinks"
 
End If
 
 
End Function



Выкладываю сам Провайдер. Чтобы не мельтешило перед глазами большое количество открывающихся окон, я его сделал с скрытым Аксессом. Чтобы его нормально открыть используйте Shift.
0
Вложения
Тип файла: rar DBServiceProvaider.rar (93.4 Кб, 3 просмотров)
Statheros
0 / 0 / 0
Регистрация: 24.08.2017
Сообщений: 62
12.07.2018, 22:01  [ТС] 13
Вроде сделал, что хотел. Работает. Прошу профи посмотреть есть ли косяки.
Visual Basic
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
84
85
86
87
88
89
90
91
92
93
94
Function funStartLink()
Dim s01 As String
Dim s02 As String
Dim strPathInterfaceDb As Boolean
Dim strPathDataDb As String
 
    'Проверяем наличие файлов Интерфейса и Базы данных
    
    'Если нет путей к файлам Интерфейса и Базы данных
If IsNull(DLookup("[InterfaceDb]", "[tblBaseLink]")) Then
    If IsNull(DLookup("[DataDb]", "[tblBaseLink]")) Then
         If MsgBox("Первое включение: Для продолжения работы необходимо указать путь к файлам Базы данных и ее интерфейса!", _
                   vbOKOnly + vbCritical, "Внимание!") = vbOK Then
                      DoCmd.OpenForm "frmLocalInstAdmin"
                      Exit Function
         End If
    End If
End If
    
    'Если нет пути к файлу Интерфейса, а к данным есть
If Not IsNull(DLookup("[InterfaceDb]", "[tblBaseLink]")) Then
     If IsNull(DLookup("[DataDb]", "[tblBaseLink]")) Then
              
              If MsgBox("Не указан путь к файлу Базы данных!" _
                     & Chr(13) & Chr(10) & "Для продолжения работы необходимо обновить путь к файлам Базы данных и ее интерфейса!", _
                     vbOKOnly + vbCritical, "Внимание!") = vbOK Then
                              DoCmd.OpenForm "frmLocalInstAdmin"
                              Exit Function
             End If
     End If
End If
 
    'Если нет пути к файлу данных, а к интерфейсу есть
If IsNull(DLookup("[InterfaceDb]", "[tblBaseLink]")) Then
     If Not IsNull(DLookup("[DataDb]", "[tblBaseLink]")) Then
              
              If MsgBox("Не указан путь к Интерфейсу Базы данных!" _
                     & Chr(13) & Chr(10) & "Для продолжения работы необходимо обновить путь к файлам Базы данных и ее интерфейса!", _
                     vbOKOnly + vbCritical, "Внимание!") = vbOK Then
                              DoCmd.OpenForm "frmLocalInstAdmin"
                              Exit Function
             End If
     End If
End If
 
    'Если есть пути к  файлам Интерфейса и Базы данных
If Not IsNull(DLookup("[InterfaceDb]", "[tblBaseLink]")) Then
    If Not IsNull(DLookup("[DataDb]", "[tblBaseLink]")) Then
    
    'Прверяем имеющийся путь к файлам Интерфейса и Базы данных
 
    s01 = Dir(DLookup("[InterfaceDb]", "[tblBaseLink]"))
    s02 = Dir(DLookup("[DataDb]", "[tblBaseLink]"))
 
         If s01 <> "" Then  'если файлы с Интерфейсом и данными нашлись
              If s02 <> "" Then DoCmd.OpenForm "frmLinks"  'запускается сжатие
         End If
         
        If s01 <> "" Then  'если файл Интерфейса нашелся, а с данными нет
              If s02 = "" Then
                  If MsgBox("Неверный путь к файлу Базы данных!" _
                     & Chr(13) & Chr(10) & "Для продолжения работы необходимо обновить путь к файлам Базы данных и ее интерфейса!", _
                     vbOKOnly + vbCritical, "Внимание!") = vbOK Then
                              DoCmd.OpenForm "frmLocalInstAdmin"
                              Exit Function
                  End If
              End If
         End If
         
        If s01 = "" Then  'если файл данными нашелся, а с Интерфейсом  нет
              If s02 <> "" Then
                  If MsgBox("Неверный путь к файлу Интерфейса Базы данных!" _
                     & Chr(13) & Chr(10) & "Для продолжения работы необходимо обновить путь к файлам Базы данных и ее интерфейса!", _
                     vbOKOnly + vbCritical, "Внимание!") = vbOK Then
                              DoCmd.OpenForm "frmLocalInstAdmin"
                              Exit Function
                  End If
              End If
         End If
         
        If s01 = "" Then  'если файлы не нашлись
              If s02 = "" Then
                  If MsgBox("Неверный путь к файлам!" _
                     & Chr(13) & Chr(10) & "Для продолжения работы необходимо обновить путь к файлам Базы данных и ее интерфейса!", _
                     vbOKOnly + vbCritical, "Внимание!") = vbOK Then
                              DoCmd.OpenForm "frmLocalInstAdmin"
                              Exit Function
                  End If
              End If
         End If
    End If
End If
 
End Function
0
Statheros
0 / 0 / 0
Регистрация: 24.08.2017
Сообщений: 62
12.07.2018, 22:07  [ТС] 14
Выкладываю файл провайдера
0
Вложения
Тип файла: rar DBServiceProvaider.rar (96.3 Кб, 1 просмотров)
12.07.2018, 22:07
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
12.07.2018, 22:07

Бекап статей из базы данных
Привет всем)) Очень нужна ваша помощь. Мне необходимо сделать бекап выбранных...

Вывод статей из базы данных
Помогите разобраться! Выдает ошибку: Notice: Undefined variable: where in...

Сжатие базы данных
Пытаюсь сжать базу данных (Access 2010). function...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
14
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2018, vBulletin Solutions, Inc.
Рейтинг@Mail.ru