VBA将新文件写入Program Files文件夹

时间:2013-06-06 01:44:47

标签: vba excel-vba excel

我有一个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

1 个答案:

答案 0 :(得分:2)

写入%PROGRAMFILES%需要Windows Vista及更高版本的管理权限(或作为受限用户运行时的XP)。应用程序不应该存储它们的数据,而且这些信息已经发布了十多年了。

此处有一个很好的参考资料,可以在Does Microsoft have a best practices document regarding the storage of App Data vs User Data on different Windows Platforms?

中找到有关存储应用程序数据的位置的信息

但是,您的问题很混乱,因为您在主题中引用了Program Files folder,但您的代码使用了C:\Documents and Settings\localhost\Desktop的硬编码路径,这不是同一回事。如果这是实际问题,可能是因为两个问题:

  1. 您已经在C:\Documents and Settings中进行了硬编码,自Windows Vista发布以来,它已不再是用户数据的正确位置。您应该使用可用于查找该文件夹的WinAPI函数。 (在此搜索SO [winapi] SHGetFolderLocation。)

  2. 您已经在用户Desktop文件夹的位置进行了硬编码,这可能不再是您认为应该在的位置。使用上面的搜索找到的相同WinAPI函数应该用于查找桌面文件夹。

  3. 即使您在正确的位置查找用户文档,localhost也不太可能有Desktop文件夹。 localhost是IP地址127.0.0.1的别名,我从来不知道IP地址别名的桌面文件夹。 localhost不是本地计算机上的用户,只有用户可以拥有桌面文件夹。