Excel VBA récupérer nom du fichier sans l'extension

[patsyl60]

Bonsoir à tous,

j'ai dans une macro besoin de récupérer le nom du fichier sans l'extension .xls.

Est ce possible ?

Actuellement, je recherche avec .name mais j'ai l'extension .xls

Je vous joins mon fichier.

D'avance merci de votre aide.

Patsyl60

 

[Staple1600]

Re : Excel VBA récupérer nom du fichier sans l'extension

Bonsoir le fil

EDITION: un moment d'égarement

MsgBox Split(wb.Name, ".")(0)

suffira


Une possibilité

Sub k()
Dim wb As Workbook
Set wb = ThisWorkbook
MsgBox Split(Dir(wb.Name), ".")(0)
End Sub

 

[david84]

Re : Excel VBA récupérer nom du fichier sans l'extension

Bonsoir,
ce code te ramène le nom sans l'extension :

Sub test()
Dim chemin As String, pos&
chemin = ActiveWorkbook.name
pos = InStr(chemin, ".xls")
MsgBox Left(chemin, pos - 1)
End Sub

A adapter à ton code.
Edit : bonsoir staple, oui effectivement
A+

 

[Staple1600]

Re : Excel VBA récupérer nom du fichier sans l'extension

Bonsoir david84

le mien aussi

PS: t'as pas du me voir passer (lol)

EDITION: houps désolé pendant que tu éditais, je te répondais.

 

[Pierrot93]

Re : Excel VBA récupérer nom du fichier sans l'extension

Bonjour à tous,

au cas ou il y a plusieurs points dans le nom du fichier :

With ThisWorkbook
    MsgBox Mid(.Name, 1, InStrRev(.Name, ".") - 1)
End With

bonne journée
@+

 

[patsyl60]

Re : Excel VBA récupérer nom du fichier sans l'extension

Bonjour Staple 1600, David84, Pierrot 93.

Merci à vous trois pour vos solutions. Les 3 solutions fonctionnent parfaitement.

Une fois de plus, Bravo à vous tous pour ce que vous faites.

Bonne journée.

Patsyl60

 

[david84]

Re : Excel VBA récupérer nom du fichier sans l'extension

Re
une autre solution en utilisant la méthode GetBaseName de l'objet FileSystemObject :

Sub test()
Dim oFSO As Object, chemin As String, Mois
chemin = ActiveWorkbook.Name
Set oFSO = CreateObject("Scripting.FileSystemObject")
MsgBox oFSO.GetBaseName(chemin)
End Sub

A+

 

[Pierrot93]

Re : Excel VBA récupérer nom du fichier sans l'extension

Re,

Allez, juste pour le plaisir de saluer David...

MsgBox CreateObject("Scripting.FileSystemObject").GetBaseName(ActiveWorkbook.Name)

bon après midi
@+

 

[david84]

Re : Excel VBA récupérer nom du fichier sans l'extension

Re
Bon ok, vu sous cet angle...
Bien vu et merci Pierrot
A+

 

[Ananas94]

Bonjour,

J'ai un peu le même problème ; sauf que je ne parviens pas à appliquer vos solution à mon fichier.
En effet, je souhaite récupérer dans une cellule le milieu du nom d'un fichier (qui est une date). Pour ce faire, voici le code correspondant :

Option Explicit
Sub Donnees_avancement()
'Lecture du fichier "np_date" pour la récupération des données :'

    Dim Chemin As String
    Dim Fichier As String
    Dim wb As Workbook
    
    Chemin = "[j'indique ici mon chemin]"
    Fichier = Dir(Chemin & "*.xlsx")
    
    Do While Len(Fichier) > 0 'le nom de fichier n'est pas vide

    If Left(Fichier, 2) = "np" Then
        Workbooks.OpenText Filename:=Chemin & Fichier, Origin:=xlWindows, _
        StartRow:=1, DataType:=xlDelimited, Local:=True, Semicolon:=True
        Set wb = ActiveWorkbook
    End If

    Fichier = Dir() 'passe au nom de fichier Excel suivant
    Loop
    
    'Récupération de la date inscrite sur le fichier :'
    
    ThisWorkbook.Activate
    ThisWorkbook.Sheets("Situ").Range("G1") = Mid(Fichier, 3, 8)
End Sub

Et il ne se passe absolument rien (sans message d'erreur nonobstant).
J'ai également essayé ce code :

Option Explicit
Sub Donnees_avancement()
'Lecture du fichier "np_date" pour la récupération des données :'

    Dim Chemin As String
    Dim Fichier As String
    Dim wb As Workbook
    Dim date_fichier As String
    
    Chemin = "[j'indique ici mon chemin]"
    Fichier = Dir(Chemin & "*.xlsx")
    
    Do While Len(Fichier) > 0 'le nom de fichier n'est pas vide

    If Left(Fichier, 2) = "np" Then
        Workbooks.OpenText Filename:=Chemin & Fichier, Origin:=xlWindows, _
        StartRow:=1, DataType:=xlDelimited, Local:=True, Semicolon:=True
        Set wb = ActiveWorkbook
    End If

    Fichier = Dir() 'passe au nom de fichier Excel suivant
    Loop
    
    'Récupération de la date inscrite sur le fichier :'
    Set date_fichier = Mid(Fichier, 3, 8)
    date_fichier.Copy
    ThisWorkbook.Activate
    ThisWorkbook.Sheets("Situ").Range("G1").PasteSpecial Paste:=xlPasteValuesEnd sub

Mais je reçois ici un message d'erreur : "objet requis" avec "date_fichier" surligné. Donc je n'opte pas pour ce code non plus...
Auriez-vous une idée s'il vous plaît ?

Merci
Anna

 

[Dranreb]

Bonjour.
C'est normal puisque Fichier = "" !
C'est en effet la condition de sortie de votre boucle.
Soit mettez un Exit Do avant le End If, soit utilisez wb.Name
Mais ce n'est même pas l'erreur signalée dans votre second code. C'est tout faux de toute façon, au point que je n'y comprends même plus mieux que le compilateur ce que vous voulez faire.

ThisWorkbook.Sheets("Situ").Range("G1") = CDate(Mid$(wb.Name, 3, 8))

 

[Ananas94]

Bonjour,

Je vous remercie vivement pour votre réponse.

1-Je ne peux pas mettre de "Exit Do" avant le "End If" car j'ai placé "loop" (pour que l'ordinateur continue de chercher tous les fichiers commençants par "np". Si je place "Exit Do" avant "loop", la boucle va s'arrêter, et l'ordinateur arrêtera de chercher.

2-Vous avez raison, mon code est faux car officiellement, le nom de mon fichier est : "*.xlsx". je suis d'accord avec vous sur ce point, il faut placer Name avant "mid". Néanmoins, la date inscrite sur le fichier est sous forme (ex pour la date d'aujourd'hui) : 9042020. Ainsi, je doute que l'ordinateur reconnaisse ceci comme une date. En effet, lorsque je teste avec CDate, c'est-à-dire cette ligne de code :

ThisWorkbook.Sheets("Situ").Range("G1") = CDate(Mid$(wb.Name, 3, 8))

J'obtiens l'erreur suivante : "Incompatibilité de type", avec cette ligne de code surlignée.
Je teste donc sans mentionner que cette portion de nom est une date :

ThisWorkbook.Sheets("Situ").Range("G1") = Mid$(wb.Name, 3, 8)

Et ça fonctionne !
Merci pour votre aide et vos encouragements.
Bonne journée.

Anna