Microsoft 365 Rechercher un fichier dans dossier

Microsoft 365 - Rechercher un fichier dans dossier

Bonjour le forum, dans mon travail, je travaille avec un fichier "Excel", lors de l'enregistrement, il se nomme "A01" suivant le nom de la tournée du jour. plus de 100 Numérotation différentes J'occupe deux postes différents soit Ce poste ou j'utilise ce fichier. Nous sommes trois à travailler...

excel-downloads.com

Cliquez pour agrandir...

bouchard à dit:

bien sûr,
ça donnerait a peu près ceci

VB:

Sub UneSolution()
chemin = "C:\Users\6810558F\OneDrive - SNCF\Documents\0-Loc Ng\04-Tournées Realisées\"
FichierDeBase = "MonFichierDeBase.xls"
nomF = InputBox("Saisir le nom du fichier sans extention", "Ouvrir fichier")
If nomF <> "" Then
    fichier = Dir(chemin & nomF & ".xls*")
    If Left(fichier, Len(nomF)) = nomF Then
        vrep = MsgBox(fichier & " trouvé. ouvrir?", vbYesNo)
        If vrep = 6 Then
            Set wb = Workbooks.Open(chemin & fichier)
        End If
     Else
        vrep = MsgBox(fichier & " non trouvé. ouvrir fichier de base ?", vbYesNo)
        If vrep = 6 Then
            Set wb = Workbooks.Open(chemin & FichierDeBase)
        End If
    End If
 Else
    MsgBox ("Recherche annulée.")
End If
End Sub

plus tard ce serait de remplir une listbox avec tous les fichiers qui répondes aux critères et de le présenter dans un formulaire...

bon code

Cliquez pour agrandir...

Dim chemin2 As String
Dim fichierDeBase As String
Dim nomF As String
Dim Fichier As String
Dim wb As Workbook
Dim VREP As String
' chemin des fichiers
chemin = "C:\Users\6810558F\OneDrive - SNCF\Documents\0-Loc Ng\04-Tournées Realisées\"
chemin2 = "C:\Users\6810558F\OneDrive - SNCF\Documents\0-Loc Ng\00-Projet Loc Ng\Projet Loc Ng 2023\01-Loc Ng 2023\"
fichierDeBase = "Loc NG 23.xlsb"
'nomF = InputBox("Saisir le nom du fichier sans extention", "Ouvrir fichier")
nomF = Sheets("Tableau de Bord").Range("G8") '<- adapter éventuellement le nom de la feuille
If nomF <> "" Then
Fichier = Dir(chemin & nomF & ".xlsb*")
If Left(Fichier, Len(nomF)) = nomF Then
VREP = MsgBox(Fichier & " Fichier existe. l'ouvrir?", vbYesNo)
If VREP = 6 Then
Set wb = Workbooks.Open(chemin & Fichier)
End If
Else
VREP = MsgBox(Fichier & " Fichier n'existe pas. Création du fichier ?", vbYesNo)
If VREP = 6 Then
Set wb = Workbooks.Open(chemin2 & fichierDeBase)
End If
End If
Else
MsgBox ("Recherche annulée.")
End If
End Sub

Cliquez pour agrandir...

Else
MsgBox ("Recherche annulée.")
End If

Cliquez pour agrandir...

La charte¸ qui se désole d'être si peu lue à dit:

1.12 - Autres points d'attention :
...
Les problèmes liés à la fourniture de liens vers des fichiers téléchargeables en dehors du forum sont les suivants : les liens expirent souvent après une certaine durée, de nombreux utilisateurs ne peuvent pas télécharger de fichiers à partir de sites de partage de fichiers en raison de restrictions de sécurité réseau, de nombreux utilisateurs hésitent à télécharger des fichiers pour des raisons de sécurité personnelle et les fonctionnalités de recherche du forum ne fonctionnent pas.
2.10 - Évitez de poser votre question sur plusieurs forums sur Internet, cette pratique s'appelle « cross posting" et elle peut être mal perçue par les membres répondant aux questions. Si vous avez déjà posté votre question ailleurs, que nous n'avez pas de réponse satisfaisante et que vous voulez la reposter sur XLD, il est possible de supprimer votre discussion sur l'autre forum.
Cela fonctionne aussi dans l'autre sens si vous souhaitez poser votre question ailleurs.

Cliquez pour agrandir...

Private Sub workbook_beforeclose(cancel As Boolean)

Dim Nom$: Nom = [D3]
Dim Nomfichier As String
Dim NomDossier As String
Dim Dte As Date
Dim dte1 As String

'Désactives les alertes
Application.DisplayAlerts = True
Application.ScreenUpdating = False
'*******************************************************************************************************************************
'Enregistrement du fichier complet
'*******************************************************************************************************************************
'Adresse de la sauvegarde
NomDossier = "C:\Loc Ng 23\04-Tournées realisées\" 'A ajuster selon ton cas
'Nom du dossier
Nomfichier = Nom & ".xlsb"
'Le fichier active est copié
ActiveWorkbook.SaveCopyAs Filename:=NomDossier & Nomfichier
' Message dinformation du lieu de l'enregistrement
MsgBox "votre ficher est enregistré intitulé:" & Nomfichier & vbNewLine & _
"dans le fichier : " & NonDossier, vbOKOnly, vbInformation, " CONFIRMATION"

'ActiveWorkbook.PrecisionAsDisplayed = True
'Application.DisplayFullScreen = False
'Application.DisplayFormulaBar = False

' With ActiveWindow
' .DisplayHorizontalScrollBar = True
' .DisplayGridlines = True
' .DisplayHeadings = True
' .DisplayVerticalScrollBar = True
' End With
'Application.Quit
End Sub

Cliquez pour agrandir...