Macro pour ouvrir .txt sur une cle quelque soit la lettre du port usb

Bonjour à tous,

S'il vous plait j'ai besoin de votre aide . J'ai créé cette macro avec l'enregistreur de macro qui me permet d'ouvrir un fichier texte à partir d'une clé USB.

Mon problème est le suivant : Dans mon projet de fin d'études, j'ai considéré que les utilisateurs n'ont pas la même adresse c'est pour cela que j'ai défini "X"mais je ne sais pas pourquoi sa m'affiche l'erreur suivante : Erreure d'exécution '9'

Sub importer()

Dim X As String

X = Left(Split(ThisWorkbook.Path, "\")(0), 1)

Workbooks.OpenText Filename:=X & ":\DOSSIER\ELEVE.txt", Origin:=xlWindows, StartRow:=1, TrailingMinusNumbers:=True

End Sub

Merci de vos réponses,

Bonne journée,

Bonjour,

il y a un exemple donné par galopin01,

ici: https://forum.excel-pratique.com/viewtopic.php?t=25270

Merci bcp de votre réponse, je vais essayer ce code

Bonjour

a voir aussi

Private Sub ChoixFicTxt()
Dim dossier As FileDialog
ChoixChemin = ActiveWorkbook.Path & Application.PathSeparator
   Set dossier = Application.FileDialog(msoFileDialogFilePicker)
      With dossier
         .AllowMultiSelect = False
         .InitialFileName = ChoixChemin
         .Title = "Choix d'un fichier Txt"
         .Filters.Clear
         .Filters.Add "Fichier Txt ", "*.txt*", 1
            If .Show = -1 Then
               Chemin = .SelectedItems(1)
               Call LireMan(Chemin)  ' Lance macro Import
            End If
      End With
   Set dossier = Nothing
End Sub

A+

Maurice

Merci de votre réponse , mais vu que je suis débutante dans le développement des VBA je n'ai pas bien compris comment personnaliser ce code. S'il vous- plait est-ce que vous pouvez m'expliquer votre code ?

Slt Isabelle, Slt le Forum,

change ton premier code avec ce code et essaie.

Sub importer()
Dim X As String
X = USBD

Workbooks.OpenText Filename:=X & ":\DOSSIER\ELEVE.txt", Origin:=xlWindows, StartRow:=1, TrailingMinusNumbers:=True

End Sub

Function USBD()
  Set fs = CreateObject("Scripting.FileSystemObject")
  Tmp = ""
  For Each d In fs.Drives
    If d.DriveType = 1 Then
      If d.IsReady Then Tmp = Tmp & d.DriveLetter
    End If
  Next
  USBD = Tmp
End Function

Merci de ta réponse effectivement j'ai suivi le code a lettre mais sa fonctionne pas et je ne sais pas ou il y'a l'erreur

Quelle erreur?

Chez moi ca fonctionne!

saddd

Voila l'erreur

il faut copier le code comme il est, sans aucun changement.

La fonction ne doit pas être dans la SUB

Sub importer()
Dim X As String
X = USBD

Workbooks.OpenText Filename:=X & ":\DOSSIER\ELEVE.txt", Origin:=xlWindows, StartRow:=1, TrailingMinusNumbers:=True

End Sub

Function USBD()
  Set fs = CreateObject("Scripting.FileSystemObject")
  Tmp = ""
  For Each d In fs.Drives
    If d.DriveType = 1 Then
      If d.IsReady Then Tmp = Tmp & d.DriveLetter
    End If
  Next
  USBD = Tmp
End Function

L'importation a bien marché merci bcccppppppp

J'ai une petite question, s'il te plait vu que j'ai 15 fichiers élèves . Comment je peux importer tous ces fichiers d'un seul coup soit dans même onglet ou chaque fichier stocker sur une onglet différent ?

Slt Isabelle,

à tester

Sub importer()
    Dim wsh As Workbook, wshact As Workbook
    Dim chemin As String, X As String, fichier As String
    Dim fichiers As New Collection
    Dim i As Long

    X = USBD
    chemin = X & ":\DOSSIER"

    If chemin = "" Then Exit Sub
    If Right(chemin, 1) <> "\" Then chemin = chemin & "\"
    fichier = Dir(chemin & "*.txt")
    If fichier = "" Then
        MsgBox "No files found", vbInformation, "Kutools for Excel"
        Exit Sub
    End If
    Do While fichier <> ""
        fichiers.Add fichier, fichier
        fichier = Dir()
    Loop
    Set wshact = ThisWorkbook
    If fichiers.Count > 0 Then
        For i = 1 To fichiers.Count
            Set wsh = Workbooks.Open(chemin & fichiers.Item(i))
            wsh.Worksheets(1).Copy after:=wshact.Sheets(wshact.Sheets.Count)
            On Error Resume Next
            ActiveSheet.Name = wsh.Name
            On Error GoTo 0
            wsh.Close False
        Next
    End If
End Sub

Function USBD()
  Set fs = CreateObject("Scripting.FileSystemObject")
  Tmp = ""
  For Each d In fs.Drives
    If d.DriveType = 1 Then
      If d.IsReady Then Tmp = Tmp & d.DriveLetter
    End If
  Next
  USBD = Tmp
End Function

D'accord je vais le tester merci bcp

Le code fonctionne bien merci énormément

alors si on veut avancer est ce que peut-on importer ces résultats dans la même feuille j'ai essayé mais j'arrive pas sachant que tous les résultats ont la même format juste les chiffres qui changent.

merci de ta collaboration et dsl si t’ennuie avec moi .

bonne journée.

Slt Isabelle,

à tester

Sub importer()
    Dim wsh As Workbook, wshact As Workbook
    Dim chemin As String, X As String, fichier As String
    Dim fichiers As New Collection
    Dim i As Long, derLigne As Long

    X = USBD
    chemin = X & ":\DOSSIER"

    If chemin = "" Then Exit Sub
    If Right(chemin, 1) <> "\" Then chemin = chemin & "\"

    fichier = Dir(chemin & "*.txt")

    If fichier = "" Then
        MsgBox "No files found", vbInformation, "Kutools for Excel"
        Exit Sub
    End If

    Do While fichier <> ""
        fichiers.Add fichier, fichier
        fichier = Dir()
    Loop

    Set wshact = ThisWorkbook
    derLigne = wshact.ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row

    If fichiers.Count > 0 Then
        For i = 1 To fichiers.Count
            Set wsh = Workbooks.Open(chemin & fichiers.Item(i))
            wsh.Worksheets(1).UsedRange.Copy Destination:=wshact.ActiveSheet.Cells(derLigne, "A")
            On Error Resume Next
            ActiveSheet.Name = wsh.Name
            On Error GoTo 0
            wsh.Close False
            derLigne = wshact.ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1
        Next
    End If
End Sub

Function USBD()
  Set fs = CreateObject("Scripting.FileSystemObject")
  Tmp = ""
  For Each d In fs.Drives
    If d.DriveType = 1 Then
      If d.IsReady Then Tmp = Tmp & d.DriveLetter
    End If
  Next
  USBD = Tmp
End Function

Bonne nuit

D'accord je vais le tester merci bcpppp

Salut m3ellem1, Je viens encore te déranger

J’aimerai bien savoir s'il te plait comment ouvrir un fichier variable stocké toujours dans le même répertoire

Exmp des fichiers: D1,D2,D3,D4……

Chemin = "C:\Users \Desktop\ TVA\"

Ce code en dessous me permet d’ouvrir le fichier D1

Par contre moi je voudrais le fichier D4(toujour le même fichier avec le nombre maximum après lettre D)

Chemin= "C:\Users \Desktop\ TVA\ "

Nomfichier=dir (chemin & "d*.xls")

Workbooks.Open Filename:=Chemin & Nomfichier

Merci d'avance de ta réponse et bonne journée

Rechercher des sujets similaires à "macro ouvrir txt cle soit lettre port usb"