禁止使用excel VBA保存给定的文件夹

我创build了一个包含许多.xls和.xlsm表单的文件夹，这个文件夹将分发给公司中的许多人，为了不改变文件夹中表单的完整性，我想禁用保存此文件夹中的任何文件，保存的所有文件将不得不被保存在与项目文件夹不同的位置。这是迄今为止发现的。

干杯

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) ' Following line will prevent all saving Cancel = True ' Following line displays the Save As Dialog box If SaveAsUI Then SaveAsUI = True ' How do I forbid the folders path ??? End Sub 

Answer 1

我已经想出了一个办法。 也许有人可以给你一个更好的答案。

它会将文件保存到您设置为C:\MyFiles默认位置，并在显示文件的path之后显示MessageBox。

如果您不想询问用户保存文件的位置并将其保存在静态位置，则通知他/她保存文件的位置，只能使用此代码。

下面的代码在这里（ThisWorkbook对象模块）

 Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) If SaveAsUI Then Cancel = True Else Dim path As String path = "C:\MyFiles\" If Len(dir(path, vbDirectory)) = 0 Then MkDir path End If Me.SaveAs Filename:=path & Me.Name, _ FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False MsgBox "This file has been saved in " & path & Me.Name Cancel = True Exit Sub End If End Sub 

更新！

如果您的所有用户都在Windows 7上，则可以将path更改为

 path = "C:\Users\" & Environ$("username") & "\Desktop\" 

无论用户名是什么，这都会发送到每个用户的桌面。 Environ$("username")函数返回当前login的用户名。

Answer 2

无论Windows O / S版本如何，此版本都保存到用户桌面

它也禁用Events以便代码不会recursion调用自己。

 Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) Dim ws As Object Set ws = CreateObject("WScript.Shell") If ThisWorkbook.Saved Then Application.EnableEvents = False ThisWorkbook.SaveAs ws.specialfolders("Desktop") & "\" & ThisWorkbook.Name MsgBox ThisWorkbook.Name & " saved to " & ws.specialfolders("Desktop") Application.EnableEvents = True Else MsgBox "workbook has not been saved before", vbCritical Cancel = True End If End Sub