Recuperer une partie du chemin d'un fichier

[Christophe]

Bonjour a tutti,

J'ai un petit soucis qui ne me parait pas compliqué, et pourtant me bloque depuyis hier soir...

En fait je recupere le chemin du classeur actif comme ça :

Fichier = ActiveWorkbook.path et tout marche niquel, fichier contient un chemin de la forme :
x:/yyyy/monFichier/

La lettre du lecteur du début (x) peut varier selon que le classeur actif est sur le reseau ou pas. Le nom (yyyy) peu varier aussi ce classeur sera dupliqué dans chaque repertoire client, donc dans fichier je recupere des choses qui varie et il faudrait que j'arrive a extraire x:/yyyy/ et je ni arrive pas...

Merci et bonne fin de matinée.

 

[Jacques87]

Bonjour Christophe

deux solutions à ton problème

1) si les 'x:' et 'yyyy' sont de longueur constante (ce qui devrait être le cas pour le nom du lecteur) du 'découpe' ta chaîne :
lecteur = left(chaine,2) par exemple

2) si ce n'est pas le cas, analyse ta chai^ne afin de trouver le premier et le dernier slash (barre oblique)

Bon courage

 

[Jam]

Salut Christophe, Jacques,

Une petite solution (auteur: Iznogood):

'retrouver le chemin, le nom de base et l'extension d'un fichier à partir de ses nom et chemin complet (3 solutions)

Sub test()
Dim Fich$
  
  Fich = Application.GetOpenFilename
  
  MsgBox GetInfo(Fich)(0) & vbLf & _
          GetInfo(Fich)(1) & vbLf & GetInfo(Fich)(2)
  MsgBox SplitInfo(Fich)(0) & vbLf & _
          SplitInfo(Fich)(1) & vbLf & SplitInfo(Fich)(2)
  MsgBox FSOInfo(Fich)(0) & vbLf & _
          FSOInfo(Fich)(1) & vbLf & FSOInfo(Fich)(2)
  
End Sub

Function GetInfo(ByVal s As String) As Variant
'Iznogood, mpfe
'Utilisation:
'GetInfo('c:\\rep\\test.xls')(0) => 'C:'
'GetInfo('c:\\rep\\test.xls')(1) => 'rep\\'
'GetInfo('c:\\rep\\test.xls')(2) => 'test.xls'
Dim Dr As String, Rep As String, Fic As String
  
  Dr = Left(s, InStr(1, s, '\\') - 1)
  Fic = s
  Do
    Fic = Right(Fic, Len(Fic) - InStr(1, Fic, '\\'))
  Loop Until InStr(1, Fic, '\\') = 0
  Rep = Mid(s, Len(Dr) + 1, Len(s) - Len(Dr) - Len(Fic))
  GetInfo = Array(Dr, Rep, Fic)
  
End Function

Function SplitInfo(NomFich$)
Dim Chemin$, NomBase$, Ext$
  NomBase = Split(NomFich, '\\')(UBound(Split(NomFich, '\\')))
  Ext = Split(NomBase, '.')(1)
  Chemin = Left(NomFich, Len(NomFich) - Len(NomBase))
  NomBase = Split(NomBase, '.')(0)
  SplitInfo = Array(Chemin, NomBase, Ext)
End Function 'fs

Function FSOInfo(NomFich$)
Dim fso, Fich, Chemin, NomBase, Ext
  Set fso = CreateObject('Scripting.FileSystemObject')
  Set Fich = fso.getfile(NomFich)
  Chemin = Fich.ParentFolder
  NomBase = fso.GetBaseName(NomFich)
  Ext = fso.GetExtensionName(NomFich)
  FSOInfo = Array(Chemin, NomBase, Ext)
End Function 'fs

Bon courage

 

[pierrejean]

bonjour tous

j'ai un peu plus simple:

Sub Macro2()
fichier = Application.Path
longueur = Len(fichier)
fichier = Mid(fichier, 4, longueur - 3) 'extraction de ?:as
For n = 1 To longueur - 3 'recherche de la position de l'antislash suivant
If Mid(fichier, n, 1) = 'as' Then Exit For
Next
fichier = Mid(fichier, n + 1, longueur - 3 - n) 'extraction de l'as et de ce qui le precede
End Sub

les antislash ne passant pas sur le forum je les ai remplcé par as

Message édité par: pierrejean, à: 25/01/2006 12:56

 

[Christophe]

Bonjour a tous,

Super les solutions j'ai essayé celle de PierreJean et ça a marché !! je suis super content j'arrive a faire des trucs de fou !!

Merci et bonne soirée.