Автообновление запуска макроса VBA? - PullRequest
Новая
       5

Автообновление запуска макроса VBA?

2 голосов
/ 07 октября 2011

Я создаю макрос Word 2003, который нужно поместить в папку %APPDATA%\Microsoft\Word\Startup.

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

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

Есть идеи?

К вашему сведению, я написал этот код. Код работает нормально для шаблонов обновлений в каталоге 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 Data\Microsoft\Word\STARTUP"
End Property

Property Get WordTemplatesPath()
    WordTemplatesPath = "Path To Application Data\Microsoft\Templates\Myapp\"
End Property


Property Get MyAppTemplatesPath()
    MyAppTemplatesPath = "p:\MyShare\templates"
End Property

Property Get XRefStartupTemplatesPath()
    MyAppStartupTemplatesPath = "p:\MyShare\startup"
End Property

[Редактировать] Я исследовал другой способ

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

Sub Macro1()
'
' Macro1 Macro
' Macro recorded 10/7/2011 by beauge
'
Application.OrganizerCopy source:="P:\MyShare\Startup\myapp_bootstrapper.dot", _
     Destination:= _
    "PathToApplication Data\Microsoft\Word\STARTUP\myapp_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:\MyShare\Startup\myapp_bootstrapper.dot", , , , , , , , , wdOpenFormatTemplate)
    Set targetProject = Application.Documents.Open("PathToApplication Data\Microsoft\Word\STARTUP\myapp_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] Еще одна неудачная попытка:

Я вставил в общий сетевой ресурс .dot со всей логикой.

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

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

1 Ответ

0 голосов
/ 04 ноября 2011

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

  1. Создать установочный пакет. Я использую скрипт NSIS
    • пакет обнаруживает любой экземпляр Winword.exe и просит пользователя повторить попытку при закрытии слова
    • извлечь из реестра путь к слову
    • развернуть файлы в папке автозагрузки слова
    • добавить деинсталлятор в локальный пользователь, добавить / удалить программы
  2. Я положил пакет в удаленный общий ресурс. Я также добавил INI-файл, содержащий последнюю версию пакета (в форме "1.0")
  3. В самом макросе у меня есть номер версии (например, "0,9").
  4. При запуске (макрос AutoExec) я сравниваю локальную версию с удаленной версией
  5. Я использую shell exec для запуска установки, если найдена более новая версия.
  6. Установка будет ждать закрытия Word

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

...