Автоматический запуск макроса VBA?


Я создаю макрос Word 2003, который должен быть помещен в папку %APPDATA%MicrosoftWordStartup.

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

Я попытался создать макрос загрузчика с помощью суб-файла AutoExec, который копирует более новую версию из общей папки в эту папку. Но поскольку Word блокирует файл, я получаю запрещенное исключение.

Есть идеи ?

К вашему сведению, я написал этот код. Код отлично работает для шаблонов обновления в Каталог templates, но не в каталоге startup:
' Bootstrapper module
Option Explicit

Sub AutoExec()
    Update
End Sub

Sub Update()

    MirrorDirectory MyPath.MyAppTemplatesPath, MyPath.WordTemplatesPath
    MirrorDirectory MyPath.MyAppStartupTemplatesPath, MyPath.WordTemplatesStartupPath

End Sub

' IOUtilities Module
Option Explicit

Dim fso As New Scripting.FileSystemObject

Public Sub MirrorDirectory(sourceDir As String, targetDir As String)
    Dim result As FoundFiles
    Dim s As Variant

    sourceDir = RemoveTrailingBackslash(sourceDir)
    targetDir = RemoveTrailingBackslash(targetDir)



    With Application.FileSearch
        .NewSearch
        .FileType = MsoFileType.msoFileTypeAllFiles
        .LookIn = sourceDir
        .SearchSubFolders = True
        .Execute
        Set result = .FoundFiles
    End With

    For Each s In result

        Dim relativePath As String
        relativePath = Mid(s, Len(sourceDir) + 1)

        Dim targetPath As String
        targetPath = targetDir + relativePath

        CopyIfNewer CStr(s), targetPath

    Next s

End Sub

Public Function RemoveTrailingBackslash(s As String)
    If Right(s, 1) = "" Then
        RemoveTrailingBackslash = Left(s, Len(s) - 1)
    Else
        RemoveTrailingBackslash = s
    End If
End Function

Public Sub CopyIfNewer(source As String, target As String)
    Dim shouldCopy As Boolean
    shouldCopy = False
    If Not fso.FileExists(target) Then
        shouldCopy = True
    ElseIf FileDateTime(source) > FileDateTime(target) Then
        shouldCopy = True
    End If

    If (shouldCopy) Then
        If Not fso.FolderExists(fso.GetParentFolderName(target)) Then fso.CreateFolder (fso.GetParentFolderName(target))
        fso.CopyFile source, target, True
        Debug.Print "File copied : " + source + " to " + target
    Else
        Debug.Print "File not copied : " + source + " to " + target
    End If
End Sub

' MyPath module

Property Get WordTemplatesStartupPath()
    WordTemplatesStartupPath = "Path To Application DataMicrosoftWordSTARTUP"
End Property

Property Get WordTemplatesPath()
    WordTemplatesPath = "Path To Application DataMicrosoftTemplatesMyapp"
End Property


Property Get MyAppTemplatesPath()
    MyAppTemplatesPath = "p:MySharetemplates"
End Property

Property Get XRefStartupTemplatesPath()
    MyAppStartupTemplatesPath = "p:MySharestartup"
End Property

[Edit] я исследовал другой путь

Еще один способ, о котором я думаю, - это пилотировать органайзер:

Sub Macro1()
'
' Macro1 Macro
' Macro recorded 10/7/2011 by beauge
'
Application.OrganizerCopy source:="P:MyShareStartupmyapp_bootstrapper.dot", _
     Destination:= _
    "PathToApplication DataMicrosoftWordSTARTUPmyapp_bootstrapper.dot" _
    , Name:="MyModule", Object:=wdOrganizerObjectProjectItems
End Sub

Это работает, но имеет ограничения:

  • либо я должен жестко кодировать модули для организации
  • или я должен изменить опцию "доверять проекту VBA" на автообнаружение элементов, подобных этому (что не приемлемо, поскольку это требует снижения безопасности станции) :

Код перечисления проектов следующий:

Public Sub EnumProjectItem()
    Dim sourceProject As Document
    Dim targetProject As Document
    Set sourceProject = Application.Documents.Open("P:MyShareStartupmyapp_bootstrapper.dot", , , , , , , , , wdOpenFormatTemplate)
    Set targetProject = Application.Documents.Open("PathToApplication DataMicrosoftWordSTARTUPmyapp_bootstrapper.dot", , , , , , , , , wdOpenFormatTemplate)
    Dim vbc As VBcomponent
    For Each vbc In sourceProject.VBProject.VBComponents 'crash here
        Application.ActiveDocument.Range.InsertAfter (vbc.Name + " / " + vbc.Type)
        Application.ActiveDocument.Paragraphs.Add

    Next vbc

End Sub

[править 2] Еще одна неудачная попытка:

Я поместил в свою сетевую папку a .точка со всей логикой.

В мою папку STARTUP я положил простой .Точечный файл, который ссылается на первый, с одним "Call MyApp.MySub".

Это действительно работает, но поскольку целевой шаблон не находится в надежном месте, предупреждение безопасности появляется каждый раз при запуске word (даже если это не так связанный с текущим макросом приложения)

1 2

1 ответ:

По крайней мере, я частично преуспеваю, используя следующие шаги:

  1. Создайте установочный пакет. Я использую скрипт НСИ
    • пакет обнаруживает любой экземпляр Winword.exe и попросите пользователя повторить попытку, когда word закрыт
    • извлеките из реестра путь опции слова
    • развертывание файлов в папке запуска word
    • Добавьте деинсталлятор в локальный пользователь установка и удаление программ
  2. я положил пакет в удаленный общий ресурс. Я также добавил .ini-файл содержащая последнюю версию пакета (в виде "1.0")
  3. в самом макросе у меня есть номер версии (например," 0.9").
  4. при запуске (макрос AutoExec) я сравниваю локальную версию с удаленной версией
  5. я использую Shell exec для запуска установки, если найдена более новая версия.
  6. Программа установки будет ждать закрытия Word

Немного сложно, но это работает на Word 2K3 и Word 2K10.