Salvare un foglio excel in un'altra Unità

di
anpol60
il
5 risposte
A
anpol60
Utente Attivo
Iscritto da
set, 2020
Messaggi:
67

Salvare un foglio excel in un'altra Unità

Buongiorno a tutti.
Uso il seguente codice in vba per salvare un file excel che si trova in una cartella del computer, su una unità USB.
Chiaramente la unità USB non avrà sempre la stessa lettera, a seconda del computer dove sarà inserita. Nel mio caso che ho due portatili, su uno la unità è la F e sull'atro è la G. Questo è il codice: 
 Dim fs2, d2, dc2
Set fs2 = CreateObject("Scripting.FileSystemObject")
Set dc2 = fs2.Drives
For Each d2 In dc2
If d2.DriveType = 1 Then
ActiveWorkbook.SaveCopyAs Filename:=d2 & "\STAMPATI\Ricorsi.xls"
End If
Next
....
Il codice funziona solo se sulla Unità USB che inserisco nel computer è già presente la cartella "STAMPATI", altrimenti il codice va in Debug. Di solito uso due chiavette USB sullo stesso computer e solo su una di essere è presente la cartella "STAMPATI"
Chiaramente il codice non va in errore se inserisco solo la chiavetta con la cartella "STAMPATI"
Quello che vorrei è fare in modo che il codice, con le opportune modifiche, riconosca solo la chiavetta usb dove è presente la cartella "STAMPATI" e salvi lì il file.
Sicuramente ci sarà la soluzione, ma proprio non ci riesco.
Grazie.

5 Risposte

  • M
    Marius44
    Utente Attivo
    Iscritto da
    set, 2015
    Messaggi:
    170

    Re: Salvare un foglio excel in un'altra Unità

    Ciao
    Molto tempo fa trovai in rete questo codice per ricavare la lettera dove si trova l'USB 
    
Public Function f() As String
   Dim objFSO As Object
   Dim colDrives As Object
   Dim objDrive As Object
   f = "Nessun drive mobile"
   Set objFSO = CreateObject("Scripting.FileSystemObject")
   Set colDrives = objFSO.Drives
   For Each objDrive In colDrives
       If objDrive.IsReady = True Then
           If objDrive.DriveType = 1 Then
               f = objDrive.DriveLetter
           End If
       End If
   Next
   Set objDrive = Nothing
   Set objFSO = Nothing
   Set colDrives = Nothing
End Function

Public Sub m()
    MsgBox f
End Sub
    La seconda macro serve per richiamare il codice principale.
    Vedi se può esserti utile. Ciao,
    Mario
  • A
    anpol60
    Utente Attivo
    Iscritto da
    set, 2020
    Messaggi:
    67

    Re: Salvare un foglio excel in un'altra Unità

    Ciao Marius44,
    ti ringrazio per il riscontro. Purtroppo anch'io ho trovato in rete un codice che mi ricava le unità rimovibili (incluso l'unità CD/DVD)
    L'istruzione di cui ho bisogno è quella che non faccia andare in Debug il codice, nel caso che una Unità collegata al pc (che può essere D oppure E oppure F oppure G ecc.) non abbia la Cartella "STAMPATI".
    Purtroppo, ti ripeto, se lavoro sul file presente sul pc e contemporaneamente è inserita una chiavetta USB che non ha la Cartella "STAMPATI", nel momento in cui salvo il file, excel va in Debug. Ho modificato con successo il codice e tutto funziona alla perfezione inserendo l'istruzione prima del salvataggio sulle Unità 
     On Error Resume Next
    Pero vorrei usare un codice "intelligente" che non mi costringa a bypassarlo con la forzatura del 
     On Error Resume Next
  • O
    oregon
    Super Famoso
    Iscritto da
    nov, 2011
    Messaggi:
    21575

    Re: Salvare un foglio excel in un'altra Unità

    Per controllare se la cartella STAMPATI esiste basta che usi la funzione Dir
  • S
    Sgrubak
    Molto attivo
    Iscritto da
    feb, 2021
    Messaggi:
    504

    Re: Salvare un foglio excel in un'altra Unità

    anpol60 ha scritto:

    ...Pero vorrei usare un codice "intelligente" che non mi costringa a bypassarlo con la forzatura del 
     On Error Resume Next
    Testa se il percorso esiste, con la funzione Dir.
    Ad esempio: 
    Dim objFSO As Object
Dim colDrives As Object
Dim objDrive As Object
Dim percorso As String

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set colDrives = objFSO.Drives
For Each objDrive In colDrives
    If objDrive.IsReady = True Then
        percorso = objDrive.path & "\STAMPATI"
        If Dir(percorso, vbDirectory) <> "" Then
            ActiveWorkbook.SaveCopyAs Filename:=percorso & "\Ricorsi.xls"
            GoTo esci
        End If
    End If
Next
MsgBox "Nessun drive mobile"
esci:
Set objDrive = Nothing
Set objFSO = Nothing
Set colDrives = Nothing
  • A
    anpol60
    Utente Attivo
    Iscritto da
    set, 2020
    Messaggi:
    67

    Re: Salvare un foglio excel in un'altra Unità

    Ciao Sgrubak,
    grazie per l'esempio che mi hai inviato.
    E' perfetto.
    Argomento risolto.
Devi accedere o registrarti per scrivere nel forum
5 risposte