Salva_WorkBook_su_prima_Path_disponibile.

[zanatta77]

Buonasera
Sto cercando di far salvare un WhorkBook .Xlsm che si trova in rete su un server che viene aperto
e lavorato in modo alterno da 5 pc (postazioni diverse), quello che vorrei facesse è semplicemente
che venga salvato sul pc che ci sta lavorando alla sua chiusura riconoscendo uno dei
percorsi predefiniti come disponibile uscendo dalla sub senza debug o segnalazione errori.
Questo è quello che provo ma non va;

Codice: Seleziona tutto

  Sub SaveFolderTrue () 'In un modulo ho messo questo
     Dim MyFile As String
       MyFile = ActiveWorkbook.Name
         Application.DisplayAlerts = False
           Folder = "C:\Users\Miriam\Desktop\r\"
           Folder = "C:\Users\Jenny\Desktop\r\"
           Folder = "C:\Users\Iris\Desktop\r\"
           Folder = "C:\Users\Nadia\Desktop\r\"
           Folder = "C:\Users\Luca\Desktop\r\"
           If Folder = True Then
             ActiveWorkbook.SaveAs Filename:=Folder & MyFile
             Else
               Exit Sub
                 End If
       
   End Sub

Codice: Seleziona tutto

Private Sub Workbook_BeforeClose(Cancel As Boolean) ' Nell'evento di chiusura del WhorkBook richiamo la Macro in esecuzione
Call SaveFolderTrue
End Sub

[Anthony47]

Ma quindi vuoi salvare il file sul desktop di chi lo apre? Se e' così allora, con questa istruzione lo calcoli e poi lo usi:

Codice: Seleziona tutto

Folder = CreateObject("WScript.Shell").Specialfolders("Desktop") & "\r\"


Insomma:

Codice: Seleziona tutto

Sub SaveFolderTrue()  'In un modulo ho messo questo
    Dim MyFile As String, Folder As String
'
    MyFile = ActiveWorkbook.Name
    Folder = CreateObject("WScript.Shell").Specialfolders("Desktop") & "\r\"
    Application.DisplayAlerts = False
        ActiveWorkbook.SaveAs Filename:=Folder & MyFile
    Application.DisplayAlerts = True
End Sub


Ciao

[zanatta77]

Buongiorno
Intanto grazie mille per quanto proposto,ma non va bene per quello che vorrei fare, in quanto in questo modo ovviamente salva sul Desktop di chiunque apre il file condiviso con altri oltre che le persone presenti sui percorsi inseriti.
Quello che vorrei che facesse è processare i percorsi predefiniti a monte che sono un dato fisso e nel caso uno di questi fosse VERO cioè disponibile va in salvataggio ed esce dalla Sub diversamente esce dalla Sub e non salva il WhorkBook.
Avevo pensato a qualcosa Boolean della Path

Codice: Seleziona tutto

If Folder = True Then
             ActiveWorkbook.SaveAs Filename:=Folder & MyFile
             Else
               Exit Sub
                 End If

[Anthony47]

Lo dico sempre: da una macro che non fa quello che si vuole fare non si capisce cosa si vuole fare...
Con le "nuove" spiegazioni, allora possiamo aggiungere il controllo tra l'utente al lavoro e una lista di utenti approvati:

Codice: Seleziona tutto

Sub SaveFolderTrue()  'In un modulo ho messo questo
    Dim MyFile As String, Folder As String
    Dim Approv
'
Approv = Array("UtenteA", "Miriam", "Jenni", "etc etc")               '<<< L'elenco degli utenti
If IsError(Application.Match(Environ("UserName"), Approv, False)) Then Exit Sub
'
    MyFile = ActiveWorkbook.Name
    Folder = CreateObject("WScript.Shell").Specialfolders("Desktop") & "\r\"
    Application.DisplayAlerts = False
        ActiveWorkbook.SaveAs Filename:=Folder & MyFile
    Application.DisplayAlerts = True
End Sub


La riga marcata <<< va ovviamente compilata coi tuoi dati
Fai sapere…

[zanatta77]

Buonasera
Ho provato oggi il tutto inserendo lo script gentilmente rivisto che compie quanto richiesto (Grazie mille Anthony47 ), successivamente ho fatto delle modifiche perchè non volevano che il salvataggio avvenisse in quel percorso ma bensì personalizzato singolarmente quindi ho fatto quanto segue che sembra funzioni, infine volevano una copia disponibile per sicurezza a ogni chiusura del file per poi cancellare il superfluo a cadenza mensile in manuale seguendo il percorso.

Codice: Seleziona tutto

Sub SaveFolderTrue()  '
    Dim MyFile As String, Folder As String
    Dim Approv
Approv = Array("Sally", "Miriam", "Jenni")             
  If IsError(Application.Match(Environ("UserName"), Approv, False)) Then Exit Sub
'    If Environ("UserName") = "Sally" Then
        Folder = ‪"C:\Users\Sally\Documents\SecurityBackup\"
     ElseIf Environ("UserName") = "Miriam" Then
        Folder = ‪"C:\Users\Miriam\Documents\Lav\SecurityBackup\"
      ElseIf Environ("UserName") = "Jenni" Then
        Folder = ‪"C:\Users\Jenni\Documents\Secondario\SecurityBackup\"
    MyFile = ActiveWorkbook.Name
    Application.DisplayAlerts = False
        ActiveWorkbook.SaveAs Filename:=Folder & MyFile + "1"
    Application.DisplayAlerts = True
End Sub

Ovviamente da quello salvato devo modificare l'estensione del file se interessato a visionarlo

Codice: Seleziona tutto

+ "1"

Grazie comunque per la disponibilità e la pazienza

[Anthony47]

Se funziona e' perfetta così
Per la prossima volta, puoi ottenere l'indirizzo del folder Documenti tramite Environ("USERPROFILE") & "\Documents"
Quindi, ad esempio:

Codice: Seleziona tutto

        Folder = Environ("USERPROFILE") & "\Documents\SecurityBackup\"

Ciao