vba - VBA 新しいファイルを Program Files フォルダーに書き込みます

Question

多くのユーザーが使用している xlsm ファイルがあり、xlsm ファイルの新しい更新が利用可能かどうかをサーバーで確認する必要がある更新機能を追加し、利用可能な場合はファイルをダウンロードする必要があります。次に、既存のファイルを上書きします。ファイルへの書き込みに失敗したエラー3004を取得する方法を教えてください。誰か助けてもらえますか?

私のコードを説明させてください。クライアントの xlsm ファイルには、新しい更新ボタンのチェックがあります。ユーザーがそのボタンをクリックすると、次のようになります。

Private Sub CommandButton5_Click()
Dim Answer As VbMsgBoxResult, N%, MyFile$

Answer = MsgBox("1) You need to be on-line to update" & vbLf & _
"2) The update may take a few minutes" & vbLf & _
"3) Please do not interrupt the process once started" & vbLf & _
"" & vbLf & _
"SEARCH FOR UPDATE?", vbYesNo, "Update?")
If Answer = vbNo Then Exit Sub

 'otherwise - carry on
Application.ScreenUpdating = False
Application.EnableCancelKey = xlDisabled


On Error GoTo ErrorProcedure

Application.Workbooks.Open ("http://www.mysite.com/Download/Update.xlsm")

 'The book on the site opens and you can do whatever you
 'want now (note that the remote book is "Read Only") - in
 'this particular case a workbook_Open event now triggers
 'a procedure to export the new file to the PC

ErrorProcedure:
MsgBox Err.Description
End Sub

次に、サーバーからの update.xlsm が開きます。コードは次のとおりです。

Private Sub workbook_open()


Dim localfile As Date
Dim newfile As Date
localfile = FileDateTime("C:\Documents and Settings\localhost\Desktop\sample.xlsm")
newfile = "6/6/2013 4:00"
If DateDiff("s", localfile, newfile) > 0 Then

MsgBox "its closed"

Application.StatusBar = "contacting the download"

Dim myURL As String
myURL = "http://www.mysite.com/Download/sample.xlsm"

Dim WinHttpReq As Object
Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
WinHttpReq.Open "GET", myURL, False
WinHttpReq.Send

Application.StatusBar = "waiting for the response"

myURL = WinHttpReq.ResponseBody
If WinHttpReq.Status = 200 Then
Application.DisplayAlerts = False
Set oStream = CreateObject("ADODB.Stream")
oStream.Open
oStream.Type = 1
oStream.Write WinHttpReq.ResponseBody
oStream.SaveToFile ("C:\Documents and Settings\localhost\Desktop\sample.xlsm")
oStream.Close
End If


MsgBox "Update Completed"
Application.StatusBar = ""
Windows("Update.xlsm").Activate
ActiveWindow.Close
Application.DisplayAlerts = True
Else
MsgBox "There is no New Update"
Application.StatusBar = ""
End If
End Sub