récupérer unité et répertoire courant

[Blafi]

Bonsoir à tous,

Je travaille avec un fichier excel sur ma clé usb qui est destinée à être branchée sur des ordinateurs différents et donc à ne jamais avoir la même lettre d'unité...

A partir de ce fichier, je dois exporter plusieurs de ses feuilles individuellement chacune dans un nouveau fichier et chacun de ces fichiers doit être enregistré sur ma clé usb et dans un dossier connu.

Le tout doit se faire par macro. Le pb : comment indiquer à la macro le chemin d'enregistrement et en particulier comment arriver à ce que la lettre d'unité puisse être recupérée par ma macro....afin de compléter le chemin d'enregistrement ?

Comme ci-dessous, j'arrive à fixer le chemin de sauvegarde mais comment remplacer C: par l'unité de la clé USB (qui varie toujours) ?:

ActiveWorkbook.SaveAs Filename:="C:\APON\le jour j\" & vava & ".xls", FileFormat:= _
xlExcel9795, Password:="", WriteResPassword:="", ReadOnlyRecommended:= _
False, CreateBackup:=False


Merci de votre aide... et à bientôt.

 

[Épaf]

Re : récupérer unité et répertoire courant

Chemin = Workbooks("NomDuFichier.xls").path
RepCourant = Curdir
Chdrive "L" 'change le lecteur
Chdir "E:\UnRep 'place dans le répertoire E:\UnRep si E est le lecteur actif

Bonne soirée

 

[Blafi]

Re : récupérer unité et répertoire courant

Merci Epaf pour la réponse...
Je note tout cela et j'essaye..

 

[MichelXld]

Re : récupérer unité et répertoire courant

bonjour

Ce lien pourra sans doute t'aider:
(lire les messages à partir du 24/07/2005, 22h24 )

https://www.excel-downloads.com/threads/sauvegarde-disquette.42150/



Bonne journée
MichelXld

 

[MichelXld]

Re : récupérer unité et répertoire courant

rebonjour


en complément:

Sub Sauvegarde_Sur_LecteurAmovible()
    Dim FSO As Object
    Dim Drv As Object
    
    'Correspond au nom que vous avez préalablement attribué à votre clé.
    Const Cible As String = "MaCle"
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    For Each Drv In FSO.Drives
        If Drv.DriveType = 1 Then
            If Drv.VolumeName = UCase(Cible) And Drv.IsReady Then
                ThisWorkbook.SaveAs Drv.DriveLetter & ":\Nom classeur.xls" ', xlWorkbook '(pour xl2007)
                Exit Sub
            End If
        End If
    Next
    
    MsgBox "Enregistrement non effectué." & vbCrLf & _
        "Le lecteur amovible '" & Cible & "' n'a pas été trouvé."
End Sub

Bonne journée
MichelXld

 

[Épaf]

Re : récupérer unité et répertoire courant

Bonjour MichelXld,
La même chose sans fso

     On error resume next
      ChDrive "Z"
     if err then msgbox "ce lecteur n'existe pas"

Mais pourquoi faire simple quand on peut faire 10 fois plus compliqué ? 😀
Bonne journée

 

[MichelXld]

Re : récupérer unité et répertoire courant

rebonjour cher Epaf

Et comment vérifies tu que le lecteur testé (z) est bien un disque amovible et qu'il est pret ? ... ;o)


Bonne journée
MichelXld

 

[Épaf]

Re : récupérer unité et répertoire courant

j'arrive à fixer le chemin de sauvegarde mais comment remplacer C: par l'unité de la clé USB (qui varie toujours) ?:

En fait, c'est vrai !

chDrive LeDrive

suffit au bonheur de Blafi 😉
@+

 

[bqtr]

Re : récupérer unité et répertoire courant

Bonjour le fil,

J'obtiens une erreur avec ton code, MichelXld, je pense que c'est dû à la présence de mon lecteur de carte mémoire (SD,CF....). C'est l'erreur 71.

Pour contourner le problème j'ai fait une petite modif en rajoutant une variable et l'instruction On Error Resume Next.
Comme cela ça fonctionne parfaitement.

Sub Sauvegarde_Sur_LecteurAmovible()
    Dim FSO As Object
    Dim Drv As Object
    Dim NomCle As String
    'Correspond au nom que vous avez préalablement attribué à votre clé.
    Const Cible As String = "MaClé"
   
    Set FSO = CreateObject("Scripting.FileSystemObject")
    On Error Resume Next
    For Each Drv In FSO.Drives
        If Drv.DriveType = 1 Then
           NomCle = Drv.VolumeName
             If NomCle = UCase(Cible) And Drv.IsReady Then
                  ThisWorkbook.SaveCopyAs Filename:=Drv.DriveLetter & ":\Nom classeur.xls" ', xlWorkbook '(pour xl2007)
                  Exit Sub
             End If
        End If
    Next
    
    MsgBox "Enregistrement non effectué." & vbCrLf & _
           "Le lecteur amovible '" & Cible & "' n'a pas été trouvé."
End Sub

Bonne journée

 

[chris]

Re : récupérer unité et répertoire courant

Bonjour
Il y avait déjà un fil à ce sujet
https://www.excel-downloads.com/threads/code-pour-acces-vers-cle-usb.79729/

A noter que la recherche maintenant limitée à des mots de plus de 4 caractères ne permet pas la recherche clé USB. C'est très génant

 

[Spitnolan08]

Re : récupérer unité et répertoire courant

Bonjour le fil,

De passage seulement, je voulais apporter une précision.
Chris, tu peux tout à fait rechercher Clé USB en tapant :
Clé* USB*

Cordialement

Edit : Et bien non, ça ne marche pas dans ce cas😕

 

[Épaf]

Re : récupérer unité et répertoire courant

Re
Il "semblerait" que pour qu'Excel reconnaisse la clé USB, il faille démarrer Excel après après avoir inséré la clé.
@+

 

[Épaf]

Re : récupérer unité et répertoire courant

Re Re
Testé

Sub Lexteur()
Dim i, Driv
    For i = 77 To 66 Step -1
        On Error Resume Next
        ChDrive Chr(i)
        DoEvents
        If Not Err Then
            On Error GoTo 0
            Driv = Split(CurDir, "\")(0)
            If USB(Driv) Then Exit Sub
        End If
    Next
End Sub

Function USB(Driv) As Boolean
    Dim fs, d, s, t
    Application.DisplayAlerts = False 'évite le message si existe déjà
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set d = fs.GetDrive(Driv)
    If d.DriveType = 1 Then
        ActiveWorkbook.SaveAs Filename:=Driv & "\" & "Essai.xls" '"\APON\le jour j\" & vava & ".xls", FileFormat:= _
xlExcel9795, Password:="", WriteResPassword:="", ReadOnlyRecommended:= _
False, CreateBackup:=False
        USB = True
    End If
    Set fs = Nothing
    Set d = Nothing
End Function

Mais je réponds à la question :

"Comment déterminer le chemin de sauvegarde pour une clé USB ?"

😛
Bon après-midi à tous, je vous fiche la paix 😀
@+