我正在构建一些 Word 2003 宏，必须将其放入
%APPDATA%\Microsoft\Word\Startup我无法更改此文件夹的位置（更改为网络共享）。我怎样才能自动更新这个宏？
我尝试创建一个引导程序宏，其中一个 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 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
这是有效的，但有局限性：
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”。这实际上是有效的，但由于目标模板不在受信任的位置，每次启动单词时都会弹出安全警告（即使与当前应用程序宏无关）