Enregistrement sur clé USB

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

mavean

XLDnaute Junior
Bonjour à tous et joyeux NOEL

j'utilise dans une macro le code suivant :

semaine = InputBox("Numéro de semaine ?")
ChDir "C:\RESTOS"
ActiveWorkbook.SaveAs Filename:= _
"C:\RESTOS\FICHIER POUR RENTRER LES STOCKS S" & semaine & ".xls", FileFormat:=xlExcel8, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False

Macro qui marche normalement, sauf que j'enregistre sur C:\ parce que je ne sais pas le faire sur une clé USB.
En effet j'utilise ce fichier sur 3 PC et la lettre de la Clé n'est jamais la même !!!
Existe t'il un code qui m'enregistre le fichier sur ma clé USB (dans le dossier RESTOS ) quel que soit le PC.
Qui peut me réécrire le code.

Merci et joyeux NOEL
 
Re : Enregistrement sur clé USB

Bonsoir à tous,

Il est indéniable que la racine C du disque dur ici présente dans l'écriture de la macro( si celle-ci fonctionne ), doit être remplacée par la racine de la clé USB !

Ce serait facile si cette racine été toujours la même "exemple" " D " mais comme tu le dit pour plusieurs PC ce ne sera pas toujours le cas !

De ce fait, sans l'obtention de cette racine et, de plus, différente ( je pense ), il est difficile d'obtenir la bonne solution !

Désolé ( pour moi ) !

bonne soirée & Joyeux Noël !
 
Re : Enregistrement sur clé USB

Joyeux Noël à mavean, à JBARBE et à toutes et tous 🙂,

Il est dommage qu'aucun fichier n'ait été fourni avec la question ! 🙁🙁

Mais comme le problème risque un jour de se présenter à moi, je m'y suis intéressé.

Un essai d'une fonction VBA : VolumeUSB(Chemin)
  • dont le paramètre d'entrée est le chemin (à partir de la racine) d'un dossier à chercher sur un volume amovible (ex: "C:\RESTOS")
  • qui retourne la lettre du premier périphérique amovible rencontré comprenant le dossier \RESTOS à sa racine
  • ou bien retourne la chaine de caractère vide si aucun lecteur amovible ne contient \RESTOS à sa racine

Si VolumeUSB(Chemin) retourne une lettre, il est ensuite facile de remplacer c: par VolumeUSB(Chemin) &":" (en supposant qu'il n'y a qu'un seul lecteur amovible qui satisfasse la condition 🙄)


Le code de la fonction :
VB:
Function VolumeUSB$(Chemin$)
Dim FSO, Volume, LettreVolume$
  Set FSO = CreateObject("Scripting.FileSystemObject")
  For Each Volume In FSO.Drives
    If Volume.drivetype = 1 Then
      If FSO.FolderExists(Volume.driveletter & Mid(CheminStockage, 2)) Then
        VolumeUSB = Volume.driveletter
        Exit Function
      End If
    End If
  Next Volume
End Function
 

Pièces jointes

Dernière édition:
Re : Enregistrement sur clé USB

Joyeux temps des Fêtes MaPomme!

Sur ma machine, j'ai le message : " Désolé ... Nous ne trouvons pas .......XLSTART\mapomme.xlam. Peut-être l'avez-vous déplacé, renommé ou supprimé?

Édit : Si j'exécute la macro manuellement, ça fonctionne ... désolé du dérangement.

Édit 2 : La macro ne trouve pas si c'est une autre unité de disque dur 8- //

Euh! Merci pour le code


Tentative
 
Dernière édition:
Re : Enregistrement sur clé USB

Bonsoir Tentative christmas_stocking.png


(...) Sur ma machine, j'ai le message : " Désolé ... Nous ne trouvons pas .......XLSTART\mapomme.xlam. Peut-être l'avez-vous déplacé, renommé ou supprimé? (...)
Essayer avec le fichier v1a dans mon premier message ici.


(...) La macro ne trouve pas si c'est une autre unité de disque dur (...)
Si c'est un disque dur interne, c'est normal -> je les exclus de ma recherche. Si c'est un disque dur externe, je n'en ai pas sous la main pour l'instant donc je ne peux pas tester.
 

Pièces jointes

  • christmas_stocking.png
    christmas_stocking.png
    5.4 KB · Affichages: 129
  • christmas_stocking.png
    christmas_stocking.png
    5.4 KB · Affichages: 137
  • christmas_stocking.png
    christmas_stocking.png
    7.1 KB · Affichages: 129
Re : Enregistrement sur clé USB

Bonjour à tous

Sinon, on peut changer la lettre d'une clé USB pour que ce soit toujours le même nom, quelque soit l'ordinateur. Exemple, vous pouvez l'appeler A.

Pour cela, click droit dans l'explorateur sur l'ordinateur, choisir gérer et Stockage (de mémoire).
 
Bonjour,

démonstration pour trouver le disque nommé "USB" :

VB:
Function FindVolume$(VOL$)
    Dim oDisks As Object, oDisk As Object
    Set oDisks = GetObject("winmgmts:\\.\root\cimv2").ExecQuery("Select * from Win32_LogicalDisk where VolumeName = '" & VOL & "'")
    For Each oDisk In oDisks:  FindVolume = oDisk.DeviceID:  Next
    Set oDisks = Nothing
End Function


Sub Demo()
    MsgBox FindVolume("USB")
End Sub
_______________________________________________________________________________
Merci de cliquer sur J'aime ce post en bas à gauche de chaque message ayant aidé …

_______________________________________________________________________________
Je suis Paris, …
 
Re : Enregistrement sur clé USB

Bonjour à tous,

Comme il peut avoir plusieurs unités qui répondent à la condition,
pour le fun: un essai qui, pour la sélection de l'unité, liste l'ensemble des lecteurs (amovibles ou pas) qui contiennent un dossier prédéfini à leur racine. (si on le désire, on peut aussi lister tous les volumes en prenant "." comme dossier prédéfini)
 

Pièces jointes

Dernière édition:
Re : Enregistrement sur clé USB

Re

Sinon, sur une appli, j'utilise ce code pour lister tous les lecteurs disponibles.

Code VBA:
Sub recherche_lecteurs_SurFeuille()
'code adapté par MJ issu de https://www.excel-downloads.com/threads/trouver-un-fichier-sur-le-pc.14470/
Derl = Range("K65536").End(xlUp).Rows.Row
Range("K2:L" & Derl).Select
Selection.ClearContents
Dim Fso As Object
Dim Drv As Object
Dim Msg$
Range("K2").Select
Set Fso = CreateObject("Scripting.FileSystemObject")
Msg = "Votre système a " & Fso.drives.Count & " lecteurs :" & vbLf & vbLf
For Each Drv In Fso.drives
With Drv
'Stop
Select Case .DriveType
Case 0 ' unknown
Msg = Msg & "Lecteur: " & .DriveLetter & " est de type inconnu." & vbLf
ActiveCell.Value = .DriveLetter & ":\"
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.Value = "type inconnu"
ActiveCell.Offset(1, -1).Range("A1").Select
Case 1 ' removable, e.g., zip
Msg = Msg & "Lecteur: " & .DriveLetter & " est un disque amovible." & vbLf
ActiveCell.Value = .DriveLetter & ":\"
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.Value = "disque amovible"
ActiveCell.Offset(1, -1).Range("A1").Select
Case 2 ' fixed, hard drive
Msg = Msg & "Lecteur: " & .DriveLetter & " est un disque dur." & vbLf
ActiveCell.Value = .DriveLetter & ":\"
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.Value = "disque dur"
ActiveCell.Offset(1, -1).Range("A1").Select
Case 3 ' remote
Msg = Msg & "Lecteur: " & .DriveLetter & " est un disque réseau." & vbLf
ActiveCell.Value = .DriveLetter & ":\"
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.Value = "disque réseau"
ActiveCell.Offset(1, -1).Range("A1").Select
Case 4 ' CDROM
Msg = Msg & "Lecteur: " & .DriveLetter & " est un CDROM." & vbLf
ActiveCell.Value = .DriveLetter & ":\"
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.Value = "CDROM"
ActiveCell.Offset(1, -1).Range("A1").Select
Case 5 ' ram disk
Msg = Msg & "Lecteur: " & .DriveLetter & " est un disque virtuel." & vbLf
ActiveCell.Value = .DriveLetter & ":\"
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.Value = "disque virtuel"
ActiveCell.Offset(1, -1).Range("A1").Select
End Select
End With
Next Drv
Cells(2, 1).Select
'MsgBox Msg, , "Lecteurs du système"
End Sub

Sub Trouve_CléUSB()
Dim Fso As Object
Dim Drv As Object
Dim Msg$
Set Fso = CreateObject("Scripting.FileSystemObject")
'MsgBox ("Votre système a " & FSO.drives.Count & " lecteurs :" & vbLf & vbLf)
For Each Drv In Fso.drives
If Drv.DriveType = 1 Then MsgBox (Drv & " est un Disque amovible")
Next

End Sub
 
Re : Enregistrement sur clé USB

Re

Ok, merci.Cela donnerait donc ceci 🙂:

Code:
Sub Trouve_CléUSB()
Dim Fso As Object
Dim Drv As Object
Dim Msg$
Set Fso = CreateObject("Scripting.FileSystemObject")
'MsgBox ("Votre système a " & FSO.drives.Count & " lecteurs :" & vbLf & vbLf)
For Each Drv In Fso.drives
If Drv.DriveType = 1 Then MsgBox (Drv & " est un Disque amovible")
If Drv.DriveType = 1 Then MsgBox (Drv.SerialNumber)
Next
End Sub
 
Recherche disque par n° de série :

on doit pouvoir aussi trouver le numéro de série d'un lecteur?.
Visualisation :

FindSerial.gif


VB:
Function FindDiskSerial$(DEV$)
    Dim oDisks As Object, oDisk As Object
    Set oDisks = GetObject("winmgmts:\\.\root\cimv2").ExecQuery("Select * from Win32_LogicalDisk where DeviceID = '" & DEV & "'")
    For Each oDisk In oDisks:  FindDiskSerial = oDisk.VolumeSerialNumber:  Next
    Set oDisks = Nothing
End Function


Function FindSerialVolume$(NUM$)
    Dim oDisks As Object, oDisk As Object
    Set oDisks = GetObject("winmgmts:\\.\root\cimv2").ExecQuery("Select * from Win32_LogicalDisk where VolumeSerialNumber = '" & NUM & "'")
    For Each oDisk In oDisks:  FindSerialVolume = oDisk.DeviceID:  Next
    Set oDisks = Nothing
End Function


Sub DemoFindDiskSerial()
    Debug.Print FindDiskSerial("K:")
End Sub


Sub DemoFindSerialVolume()
    Debug.Print FindSerialVolume("1")
End Sub
_______________________________________________________________________________
Merci de cliquer sur J'aime ce post en bas à gauche de chaque message ayant aidé …
 
Dernière édition:
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
7
Affichages
572
Réponses
20
Affichages
3 K
Retour