2
我正在構建一些必須放入%APPDATA%\Microsoft\Word\Startup文件夾的Word 2003宏。AutoUpdate VBA啓動宏？
我無法更改此文件夾的位置（到網絡共享）。我怎樣才能自動更新這個宏？
我試圖創建一個引導程序宏，使用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
這是工作，但有其侷限性：
- 任我不得不硬代碼模塊來組織
- 或我必須改變選項「信託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]另一個unsucc essful嘗試：
我把我的網絡共享，所有的邏輯.dot。
在我的STARTUP文件夾中，我將一個簡單的.Dot文件引用前一個文件，並帶有一個「Call MyApp.MySub」。
這實際上是工作，但是作爲目標模板沒有一個可信的位置，安全警告每個字啓動時間（即使不涉及到當前應用宏）彈出