Использование VBA в Excel для принудительного сохранения в каталоге

Question

У меня есть огромная электронная таблица Excel, мне нужно разрешить доступ большому кругу пользователей, чтобы они могли манипулировать ею для своих клиентов, но я не хочу, чтобы они могли перезаписывать исходный файл (переменная легко устанавливается в Excel) или сохраните их файл за пределами текущей папки - поэтому я хочу принудительно перевести их в режим «saveas» и принудительно сохранить файл в этой папке. В противном случае они не смогут сохранить. Я не очень разбираюсь в VBA, и я нашел много примеров, которые могут сработать, но, кажется, ничто не является именно тем, что мне нужно, или, может быть, я недостаточно умен, чтобы понять это. Я нашел этот код, но я не уверен, что он решает проблему. Помогите?

Я пытался управлять этим в объектах групповой политики, но, похоже, все дает им доступ к загрузке папки и сохранению в других местах.

Sub ExampleToSaveWorkbookSet()

Dim wkb As Workbook
'Adding New Workbook
Set wkb = Workbooks.Add
'Saving the Workbook
wkb.SaveAs "C:\WorkbookName.xls"
'OR
'wkb.SaveAs Filename:="C:\WorkbookName1.xls"

End Sub

Ожидаемый вывод - исправленный файл Excel, сохраненный в исходном каталоге с другим именем или не сохраненный вообще.

Answer 1

Вот макрос, который запускается при открытии и сразу сохраняет как .xlsx в местоположение пользователя, которое вы можете указать.К сожалению, оригинал должен быть .xlsm для хранения макроса.Этот макрос должен находиться в объекте ThisWorkbook.Он будет завершен до создания копии при открытии книги.

Private Sub Workbook_Open()
    Dim wb As Workbook
    Set wb = ActiveWorkbook
    vWbName = wb.Name
    vUserProf = Environ("USERPROFILE")
    vx = InStr(1, vUserProf, "Users\")
    If "<Use your own profileID>" = Mid(vUserProf, vx + 6) Then Exit Sub
    vDir = vUserProf & "\Downloads\"
    vWbName = Left(vWbName, Len(vWbName) - 5) & ".xlsx"
    wb.SaveAs vDir & vWbName, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    MsgBox "You are now using a copy of the original"
End Sub