Dececter insertion carte flash

fixfly

XLDnaute Nouveau
Bonjour à tous!

J'ai une macro qui fait un travail sur plusieurs fichiers existant sur une carte flash. (disque f: chez moi)

Il faut que je renouvelle l'opération de façon industrielle (j'ai plusieurs centaines de cartes flash à faire...)

J'aimerais en vba trouver le code qui serait l'équivalent de:
A l'évènement "insertion d'une carte flash dans le lecteur f ", déclenche la macro.

C'est possible ça en VBA ?
Merci!!
 
Dernière édition:

job75

XLDnaute Barbatruc
Re : Dececter insertion carte flash

Bonsoir fixfly,

Il n'existe pas d'évènement (au sens VBA) lié à l'insertion dans un lecteur.

Mais on peut réaliser une macro qui, toutes les secondes par exemple, détecte si le lecteur F contient un fichier Excel .xls, et procède à son traitement :

1) Dans ThisWorkbook la macro :

Code:
Private Sub Workbook_Open()
Application.OnTime Now, "CarteFlash"
End Sub

2) Dans un Module :

Code:
Sub CarteFlash()

Static FichFait As String 'mémorisation
Dim NouvFich As String
Application.OnTime Now + TimeValue("0:0:1"), "CarteFlash"

On Error Resume Next
NouvFich = Dir("F:\*.xls") 'nom du nouveau fichier
If NouvFich = "" Or NouvFich = FichFait Then Exit Sub

On Error GoTo 0
FichFait = NouvFich
Workbooks.Open "F:\" & NouvFich 'ouvre le fichier 

'Le code pour le traitement du fichier
'-------------------------------------

End Sub

La variable Static FichFait est nécessaire pour que le traitement du fichier n'ait lieu qu'une fois...

Edit : pour fermer le fichier contenant ces macros, fermer Excel, sinon le fichier se rouvre...

A+
 
Dernière édition:

job75

XLDnaute Barbatruc
Re : Dececter insertion carte flash

Rebonsoir flixfly,

Pardon, je n'avais pas intégré le fait qu'une carte flash peut contenir plusieurs fichiers Excel à traiter.

La macro dans le Module ne traitait qu'un fichier, il faut la modifier ainsi :

Code:
Sub CarteFlash()

Static FichFait As String 'mémorisation
Dim NouvFich As String
Application.OnTime Now + TimeValue("0:0:1"), "CarteFlash"

On Error Resume Next
NouvFich = Dir("F:\*.xls") 'nom du nouveau fichier
If NouvFich = FichFait Then Exit Sub

On Error GoTo 0
FichFait = NouvFich

[COLOR="Red"]While NouvFich <> "" 'boucle sur tous les fichiers Excel[/COLOR]
Workbooks.Open "F:\" & NouvFich 'ouvre le fichier 
'Le code pour le traitement du fichier
'-------------------------------------
[COLOR="Red"]NouvFich = Dir 'fichier suivant
Wend[/COLOR]

End Sub

Bonne fin de soirée.
 
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
312 685
Messages
2 090 932
Membres
104 703
dernier inscrit
romla937