armelle1303
XLDnaute Junior
bonsoir à tous
comme vous le doutez si je suis là c'est parce que je ne trouve pas la solution :
lorsque j'exécute ma 1ère boucle, pour I = 1 mon code fonctionne mais lorsque je valide Next I , il me renvoie "l'indice n'appartient pas à la sélection" à la ligne msgbox... juste après For I= 1 to ....
donc il ne trouve pas le 2èmé fichier trouvé (enfin je crois).
est ce que c'est parce que j'ai fait un 2ème FileSearch qui ne me trouve qu'un fichier et il a donc mis la valeur à 1.
Si oui , savez vous comment faire pour éviter ceci ou remettre found files au nombre d'origine
j'ai essayé en mettant avant le nbr de found files dans une variable mais cela ne marche pas où alors il faudrait peut être mettre tous les chemins dans une variable avec une boucle et ....ouhhlà des boucles partout je m'emmêle les pinceaux.
but du code : je recherche tous les fichiers.dft d'un répertoire et regarde si il existe un fichier au même nom mais en pdf, si oui je compare les dates de création , si identiques RAS, sinon je récupère le chemin du fichier dans la feuille Excel.
Bon voilà j'espère avoir été claire et avoir plus de chances qu'avec mes derniers posts qui n'ont pas eu beaucoup de succès
j'ai vu un post sur la réinitialisation de filesearch mais ce n'était pas le même pb. apparemment il n'y avait pas de solution et il a fallut contourner le pb.
en dernier recours c'est ce que j'essaierai de faire pour n'avoir qu'un Filesearch mais cela va compliquer mon code alors si on peut faire simple pourquoi s'en priver.
comme vous le doutez si je suis là c'est parce que je ne trouve pas la solution :
lorsque j'exécute ma 1ère boucle, pour I = 1 mon code fonctionne mais lorsque je valide Next I , il me renvoie "l'indice n'appartient pas à la sélection" à la ligne msgbox... juste après For I= 1 to ....
donc il ne trouve pas le 2èmé fichier trouvé (enfin je crois).
est ce que c'est parce que j'ai fait un 2ème FileSearch qui ne me trouve qu'un fichier et il a donc mis la valeur à 1.
Si oui , savez vous comment faire pour éviter ceci ou remettre found files au nombre d'origine
j'ai essayé en mettant avant le nbr de found files dans une variable mais cela ne marche pas où alors il faudrait peut être mettre tous les chemins dans une variable avec une boucle et ....ouhhlà des boucles partout je m'emmêle les pinceaux.
but du code : je recherche tous les fichiers.dft d'un répertoire et regarde si il existe un fichier au même nom mais en pdf, si oui je compare les dates de création , si identiques RAS, sinon je récupère le chemin du fichier dans la feuille Excel.
Bon voilà j'espère avoir été claire et avoir plus de chances qu'avec mes derniers posts qui n'ont pas eu beaucoup de succès
j'ai vu un post sur la réinitialisation de filesearch mais ce n'était pas le même pb. apparemment il n'y avait pas de solution et il a fallut contourner le pb.
en dernier recours c'est ce que j'essaierai de faire pour n'avoir qu'un Filesearch mais cela va compliquer mon code alors si on peut faire simple pourquoi s'en priver.
PHP:
Sub compareFichier()
Dim ScanFic As Office.FileSearch
Dim Nbr As Long
Dim I As Long, K As Long
Dim DernLig As Long
Dim FileItem, FileItem2
Dim FSO As Scripting.FileSystemObject
Dim Fl As Scripting.File
repertoire = ThisWorkbook.Path
'attention : adapter le repertoire à chaque poste de travail
Sheets(1).Activate: Sheets(1).Select: Cells.Clear
Cells(1, 1).Value = "Tous les fichiers dft ci-dessous n'ont pas de copie en pdf pour la diffusion"
Cells(1, 2).Value = Now
Set ScanFic = Application.FileSearch
With ScanFic
.NewSearch
.LookIn = repertoire
.SearchSubFolders = True
.MatchTextExactly = False
.Filename = "*.dft"
If .Execute > 0 Then
Nbr = .Execute
Application.ScreenUpdating = False
For I = 1 To .FoundFiles.Count
MsgBox Application.FileSearch.FoundFiles(I) 'pour prog
FileItem = .FoundFiles(I)
Set FSO = New Scripting.FileSystemObject
nomFich = FSO.GetBaseName(FileItem)
Set File = FSO.GetFile(FileItem)
datCr = File.DateCreated
dateCrea = VBA.Left(datCr, 10)
'pour chaque fichier trouvé , recherche si existe avec même nom mais en .pdf
Set ScanFic2 = Application.FileSearch
With ScanFic2
.NewSearch
.LookIn = repertoire
.SearchSubFolders = True
.MatchTextExactly = True
.Filename = nomFich & ".pdf"
If .Execute > 0 Then
Nbr1 = .Execute
MsgBox Application.FileSearch.Filename
'compare les dates
For K = 1 To .FoundFiles.Count
FileItem2 = .FoundFiles(K)
Set File2 = FSO.GetFile(FileItem2)
MsgBox File2
datCr2 = File2.DateCreated
dateCrea2 = VBA.Left(datCr2, 10)
If dateCrea2 <> dateCrea Then
Sheets(1).Select
DernLig = Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row + 1
Cells(DernLig, 1) = File.Path
Else
GoTo 1:
End If
Next K
Else
GoTo 1:
End If
End With
1:
Next I
If DernLig > 2 Then
Range("A2:F" & DernLig).Select 'tri sur base col A
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
ActiveSheet.Columns.AutoFit: Range("A1").Select
End If
Set FileItem = Nothing
End If
End With
End Sub