2017-07-26 15 views
1

我需要將個人Excel工作簿文件從聯網驅動器複製到約20臺不同PC上的C:\ Users \用戶名\ AppData \ Roaming \ Microsoft \ Excel \ XLSTART。我想簡化它,因爲它可能成爲一個更常見的任務。參考Windows用戶/用戶名文件夾

這裏是我當前的代碼,如果我實際上有DestinationFile聲明中硬編碼的用戶名。

Const DestinationFile = "C:\Users\username\AppData\Roaming\Microsoft\Excel\XLSTART\Personal.xlam" 
Const SourceFile = "H:\Folder\Folder\Folder\Personal.xlam" 

Set fso = CreateObject("Scripting.FileSystemObject") 
'Check to see if the file already exists in the destination folder 
If fso.FileExists(DestinationFile) Then 
    'Check to see if the file is read-only 
    If Not fso.GetFile(DestinationFile).Attributes And 1 Then 
     'The file exists and is not read-only. Safe to replace the file. 
     fso.CopyFile SourceFile, "H:\Folder\Folder\Folder\Folder\", True 
    Else 
     'The file exists and is read-only. 
     'Remove the read-only attribute 
     fso.GetFile(DestinationFile).Attributes = fso.GetFile(DestinationFile).Attributes - 1 
     'Replace the file 
     fso.CopyFile SourceFile, "H:\Folder\Folder\Folder\Folder\", True 
     'Reapply the read-only attribute 
     fso.GetFile(DestinationFile).Attributes = fso.GetFile(DestinationFile).Attributes + 1 
    End If 
Else 
    'The file does not exist in the destination folder. Safe to copy file to this folder. 
    fso.CopyFile SourceFile, "H:\Folder\Folder\Folder\Folder\", True 
End If 
Set fso = Nothing 

回答

2

這裏有一個方法來確定應用程序數據文件夾,這看起來是你的主要問題:

Dim shell 
Set shell = CreateObject("WScript.Shell") 
MsgBox shell.ExpandEnvironmentStrings("%APPDATA%") 
+0

幫助。謝謝。它指出我在正確的方向。 – Robby