Добавить справочную библиотеку во внешнюю базу данных MS Access - PullRequest
1 голос
/ 30 мая 2020

У меня есть код, который создает новые базы данных MS Access. Я хотел бы добавить справочные библиотеки к этим вновь созданным базам данных MS Access. Вот код, который я написал, но не работает:

Sub makeDb(fl As String)    
Dim fs
Set fs = CreateObject("Scripting.FileSystemObject")

'check if the file already exists

If fs.FileExists(fl) = False Then

    'create new ms access database

    Dim accessApp As Access.Application
    Set accessApp = New Access.Application
    accessApp.DBEngine.CreateDatabase fl, dbLangGeneral

    'loop through all references in current database and add them to the newly created dbs

    Dim cur_vbProj As VBIDE.VBProject: Set cur_vbProj = Application.VBE.VBProjects(1)
    Dim cur_vbRefs As VBIDE.References: Set cur_vbRefs = cur_vbProj.References
    Dim cur_vbRef As VBIDE.Reference

    For Each cur_vbRef In cur_vbRefs
        Dim cur_guid As String: cur_guid = cur_vbRef.Guid
        Dim cur_major As Long: cur_major = cur_vbRef.Major
        Dim cur_minor As Long: cur_minor = cur_vbRef.Minor

        'here is the code that doesn't work

        Dim vbProj As VBIDE.VBProject: Set vbProj = accessApp.Application.VBE.VBProjects(1)
        Dim vbRefs As VBIDE.References: Set vbRefs = vbProj.References
        vbRefs.AddFromGuid Guid:=cur_guid, Major:=cur_major, Minor:=cur_minor

    Next

    accessApp.Quit
    Set accessApp = Nothing

End If

End Sub

Строка Set vbProj = accessApp.Application.VBE.VBProjects(1) выдает ошибку времени выполнения '9' Подстрочный индекс вне допустимого диапазона. Как мне изменить код? Можно ли вообще добавить ссылки на внешнюю базу данных?

1 Ответ

1 голос
/ 30 мая 2020

У меня работает:

Sub makeDb(f1 As String)
Dim accApp As Access.Application
Dim cur_vbRefs As References
Dim cur_vbRef As Reference
If Dir(f1) = "" Then
    Access.DBEngine.CreateDatabase f1, dbLangGeneral
    Set accApp = New Access.Application
    accApp.OpenCurrentDatabase f1
    'loop through all references in current database and add them to the newly created dbs
    Set cur_vbRefs = Application.References
    For Each cur_vbRef In cur_vbRefs
        On Error Resume Next
        accApp.References.AddFromGuid cur_vbRef.Guid, cur_vbRef.Major, cur_vbRef.Minor
    Next
End If
End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...