-2
I need to share a workbook on the network, but when running the code the file goes to the folder C:\Documents\
.
What would be the solution to this problem?
Private Sub btExecuta_Click()
Dim NovoNomeArquivo As String
Dim vPlan As Worksheet
Application.DisplayAlerts = False
'- Remover o Compartilhamento
On Error Resume Next
ActiveWorkbook.ExclusiveAccess '- Acesso Exclusivo
On Error GoTo 0
Application.DisplayAlerts = True
'- Mesclar Celulas
ActiveSheet.Range("B3:C7").Merge
'-- SALVA CÓPIA DA PLANILHA EM DETERMINADO PERIODO
'-- Salva Pasta de trabalho antes de duplicar
ActiveWorkbook.Save
'-- Verifica o caminho onde esta salvo a pasta de trabalho
NovoNomeArquivo = ActiveWorkbook.Path & "\" & Mid$(ActiveWorkbook.Name, 1, Len(ActiveWorkbook.Name) - 5) _
& " - " & Format(Date, "yyyy-mm-dd") & ".xlsm"
ActiveWorkbook.SaveCopyAs NovoNomeArquivo
'-- PROTEGER AS PLANILHAS COM SENHA
'Com exceção da planilha INSTRUÇÃO
'-- Ignora a pergunta se quer salvar
Application.DisplayAlerts = True
'-- BLOQUEIA TODAS AS PLANILHAS
For Each vPlan In Sheets
If vPlan.Name <> "INSTRUÇÃO" Then
vPlan.Protect Password:="123"
End If
Next vPlan
'-- COMPARTILHA A PLANILHA
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs ActiveWorkbook.Name, accessmode:=xlShared
Application.DisplayAlerts = True
MsgBox " Processo Concluído", vbOKOnly + vbExclamation
End Sub