Что-то подобное и ошибки прав доступа или просто отсутствия ресурса я не проверял.
| Код |
|---|
Sub Backup_Active_Workbook()
Const strNetworkPath = "\\192.168.0.33\X"
Const strUser = "MyDomain\User"
Const strPassword = "12345"
Dim shell As Object
Dim commandString As String
Set shell = CreateObject("WScript.shell")
commandString = shell.ExpandEnvironmentStrings("%WINDIR%") & "\system32\net.exe use " & strNetworkPath & " /User:" & strUser & " " & strPassword
shell.Run (commandString), 0, True
' WScript.Sleep 500 может потребоваться, но тогда надо это менять на то, что работает в excel
ActiveWorkbook.SaveCopyAs Filename:=strNetworkPath & "\Пример 1.xlsm"
commandString = shell.ExpandEnvironmentStrings("%WINDIR%") & "\system32\net.exe use " & strNetworkPath & " /D"
shell.Run (commandString), 0, False
Set shell = Nothing
End Sub
|
Только вот пароль открытым текстом.
Также с одной стороны правильнее получить системный путь
| Код |
|---|
Dim objFSO, strWindowsFolder
Set objFSO = CreateObject("Scripting.FileSystemObject")
strSystemFolder = objFSO.GetSpecialFolder(1)
|
а не через переменную окружения и довесок, но смысла особого нет.
