Réponse acceptée !
a partir de ce que j'ai trouvé sur le forum j'ai trouvé une solution à mon pb :
Function sChangeCaractere(ByVal laChaine As String, ByVal old_car As String, ByVal new_car As String) As String
Dim ncar As Integer, lng As Integer, result As String, txt As String
lng = Len(old_car)
txt = laChaine
If lng <= 0 Then
sChangeCaractere = txt
Exit Function
End If
On Error GoTo ErrChangeCaractre
If lng <= 0 Or Len(Trim(txt)) <= 0 Then
sChangeCaractere = txt
Exit Function
End If
result = vbNullString
ncar = InStr(txt, old_car)
Do While ncar
If Len(result) > 0 Then
If lng > 1 Then
If ncar = 1 Then
result = result & new_car
Else
result = result & Left(txt, ncar - 1) & new_car
End If
Else
result = result & Left(txt, ncar - 1) & new_car
End If
Else
result = Left(txt, ncar - 1) & new_car
End If
If lng > 1 Then
txt = Right(txt, Len(txt) - ncar - (lng - 1))
Else
txt = Right(txt, Len(txt) - ncar)
End If
ncar = InStr(txt, old_car)
Loop
If Len(txt) > 0 Then result = result & txt
sChangeCaractere = result
Exit Function
ErrChangeCaractre:
sChangeCaractere = result
End Function
Sub parcours_arborescence()
disque = "C"
chemin = "c:\temp\toto\"
Set fs = Application.FileSearch
Set fso = CreateObject("Scripting.FileSystemObject")
With fs
.LookIn = chemin
.SearchSubFolders = True
.Filename = "*.xls"
If .Execute() > 0 Then
MsgBox "There were " & .FoundFiles.Count & _
" file(s) found."
For i = 1 To .FoundFiles.Count
Set fic = fso.GetAbsoluteFileName(.FoundFiles(i))
'MsgBox fso.GetAbsolutePathName(.FoundFiles(i))
Next i
Else
MsgBox "There were no files found."
End If
End With
End Sub
Sub traite_tous_les_fichier_d_un_dossier()
disque = "C"
chemin = "c:\temp\toto\"
fichier_log = chemin & "resultat.log"
chemin_origine = "T:\toto\tata\titi"
chemin_nouveau = "c:\temp"
ChDrive (disque)
ChDir (chemin)
Set FSys = CreateObject("Scripting.FileSystemObject")
FSys.DeleteFile (fichier_log)
Set MonFic = FSys.CreateTextFile(fichier_log, False)
If Err.Number = 0 Then
MonFic.writeLine "Fichiers non traites"
Else
FSys.DeleteFile (fichier_log)
Set MonFic = FSys.CreateTextFile(fichier_log, False)
MonFic.writeLine "Fichiers non traites"
End If
With Application.FileSearch
Dim fichier_fait As Boolean
Dim cpt_fait As Long
Dim cpt_total As Long
Dim fic As String
cpt_fait = 0
'.NewSearch
.LookIn = chemin
.SearchSubFolders = True
'.FileType = msoFileTypeExcelWorkbooks
.Filename = "*.xls"
If .Execute > 0 Then
MsgBox "There were " & .FoundFiles.Count & _
" file(s) found."
cpt_total = .FoundFiles.Count
For i = 1 To .FoundFiles.Count
fic = .FoundFiles(i)
fichier_fait = False
Dim strold As String
Dim c_Wks As Workbook
Set c_Wks = Workbooks.Open(.FoundFiles(i))
'MsgBox c_Wks.Name
For j = 1 To Modules.Count
With c_Wks.VBProject.VBComponents.Item(j).CodeModule
Dim cmpt As Long
cmpt = .CountOfLines
Dim c_start As Long
Dim b As Boolean
Dim x As Long
x = 1
b = .Find(chemin_origine, x, 1, -1, -1)
If b = True Then
Dim temp As String
temp = .Lines(x, 1)
Dim s_temp As String
s_temp = sChangeCaractere(temp, chemin_origine, chemin_nouveau)
.ReplaceLine x, s_temp
fichier_fait = True
cpt_fait = cpt_fait + 1
End If
End With
Next j
If Not fichier_fait Then
'fic = CStr(FSys.GetAbsoluteFileName(.FoundFiles(i)))
MonFic.writeLine (FSys.GetAbsolutePathName(.FoundFiles(i)))
'MsgBox FSys.GetAbsolutePathName(.FoundFiles(i))
End If
c_Wks.Save
c_Wks.Close
'.FoundFiles.Item(i).Close
Next i
Else
MsgBox "Aucun fichier n'a été trouvé."
End If
End With
MonFic.Close
End Sub