Problème code VBA gestion dossier

Le 26/11/2013 à 11:57

Bonjour,

j'ai besoin d'afficher un certains nombre de fichiers à partir de la date saisie par l'utilisateur. par exemple l'utilisateur saisit 01/01/2013, tous les fichiers dont la date de modification est supérieure à cette date doivent s'afficher.mon souci c'est que je n'arrive pas à contrôler le cas ou aucun fichier ne répond à ce critère.

voici un bout du code si ça peut servir.

If Date_Fic <= VBA.Int(VBA.CDate(FichierCourant.ModifDern)) Then

If VBA.InStr(FichierCourant.Proprietaire, "\") Then

Proprietaire = VBA.Split(FichierCourant.Proprietaire, "\")

RgDeb.Offset(comp, COL_FICH_NOM) = FichierCourant.Nom

RgDeb.Worksheet.Hyperlinks.Add anchor:=RgDeb.Offset(comp, COL_FICH_NOM), Address:=FichierCourant.Chemin

'RgDeb.Offset(ICollec, COL_FICH_TYPE) = FichierCourant.Typ

'RgDeb.Offset(ICollec, COL_FICH_ATTRIB) = FichierCourant.Attrib

RgDeb.Offset(comp, COL_FICH_CHEMIN) = FichierCourant.Chemin

RgDeb.Worksheet.Hyperlinks.Add anchor:=RgDeb.Offset(comp, COL_FICH_CHEMIN), Address:=FichierCourant.SousDossHyper

'RgDeb.Offset(ICollec, COL_FICH_DATECREATION) = FichierCourant.DateCreation

RgDeb.Offset(comp, COL_FICH_MODIFDERN) = FichierCourant.ModifDern

'RgDeb.Offset(ICollec, COL_FICH_ACCESDERN) = FichierCourant.AccesDern

'RgDeb.Offset(ICollec, COL_FICH_PROPRIETAIRE) = FichierCourant.Proprietaire

RgDeb.Offset(comp, COL_FICH_PROPRIETAIRE) = Proprietaire(1)

RgDeb.Offset(comp, COL_FICH_TAILLE) = FichierCourant.Taille

'RgDeb.Offset(ICollec, COL_FICH_SOUSDOSS) = FichierCourant.SousDoss

'RgDeb.Offset(ICollec, COL_FICH_SOUSDOSSRG) = FichierCourant.SousDossRg

'RgDeb.Offset(ICollec, COL_FICH_MODIF30) = FichierCourant.Modif30

'RgDeb.Offset(ICollec, COL_FICH_MODIF06) = FichierCourant.Modif06

comp = comp + 1

Else

RgDeb.Offset(comp, COL_FICH_NOM) = FichierCourant.Nom

RgDeb.Worksheet.Hyperlinks.Add anchor:=RgDeb.Offset(comp, COL_FICH_NOM), Address:=FichierCourant.Chemin

RgDeb.Offset(comp, COL_FICH_CHEMIN) = FichierCourant.Chemin

RgDeb.Worksheet.Hyperlinks.Add anchor:=RgDeb.Offset(comp, COL_FICH_CHEMIN), Address:=FichierCourant.SousDossHyper

'RgDeb.Offset(ICollec, COL_FICH_DATECREATION) = FichierCourant.DateCreation

RgDeb.Offset(comp, COL_FICH_MODIFDERN) = FichierCourant.ModifDern

'RgDeb.Offset(ICollec, COL_FICH_ACCESDERN) = FichierCourant.AccesDern

RgDeb.Offset(comp, COL_FICH_PROPRIETAIRE) = FichierCourant.Proprietaire

RgDeb.Offset(comp, COL_FICH_TAILLE) = FichierCourant.Taille

comp = comp + 1

End If

If comp = 32000 Then

Call Feuillesuiv(nb)

comp = 1

nb = nb + 1

End If

' If Date_Fic > VBA.Int(VBA.CDate(FichierCourant.ModifDern)) Then

' comp = 0

' MsgBox "Aucun fichier à afficher après cette date"

' End If

merci à vous

Le 26/11/2013 à 13:16

bonjour,

peux-tu fournir le code incluant la boucle ?

Ton test sur le nombre de fichiers correspondant au critère doit se faire après l'exécution de la boucle.

Le 26/11/2013 à 14:03

Voici le code incluant la boucle:

For ICollec = 1 To eCollectionFichier.Count

Set FichierCourant = eCollectionFichier.Item(ICollec)

Set fso = New Scripting.FileSystemObject

strFile = FichierCourant.Chemin

Set fle = fso.GetFile(strFile)

FichierCourant.ModifDern = fle.DateLastModified

If Date_Fic <= VBA.Int(VBA.CDate(FichierCourant.ModifDern)) Then

If VBA.InStr(FichierCourant.Proprietaire, "\") Then

Proprietaire = VBA.Split(FichierCourant.Proprietaire, "\")

RgDeb.Offset(comp, COL_FICH_NOM) = FichierCourant.Nom

RgDeb.Worksheet.Hyperlinks.Add anchor:=RgDeb.Offset(comp, COL_FICH_NOM), Address:=FichierCourant.Chemin

'RgDeb.Offset(ICollec, COL_FICH_TYPE) = FichierCourant.Typ

'RgDeb.Offset(ICollec, COL_FICH_ATTRIB) = FichierCourant.Attrib

RgDeb.Offset(comp, COL_FICH_CHEMIN) = FichierCourant.Chemin

RgDeb.Worksheet.Hyperlinks.Add anchor:=RgDeb.Offset(comp, COL_FICH_CHEMIN), Address:=FichierCourant.SousDossHyper

'RgDeb.Offset(ICollec, COL_FICH_DATECREATION) = FichierCourant.DateCreation

RgDeb.Offset(comp, COL_FICH_MODIFDERN) = FichierCourant.ModifDern

'RgDeb.Offset(ICollec, COL_FICH_ACCESDERN) = FichierCourant.AccesDern

'RgDeb.Offset(ICollec, COL_FICH_PROPRIETAIRE) = FichierCourant.Proprietaire

RgDeb.Offset(comp, COL_FICH_PROPRIETAIRE) = Proprietaire(1)

RgDeb.Offset(comp, COL_FICH_TAILLE) = FichierCourant.Taille

'RgDeb.Offset(ICollec, COL_FICH_SOUSDOSS) = FichierCourant.SousDoss

'RgDeb.Offset(ICollec, COL_FICH_SOUSDOSSRG) = FichierCourant.SousDossRg

'RgDeb.Offset(ICollec, COL_FICH_MODIF30) = FichierCourant.Modif30

'RgDeb.Offset(ICollec, COL_FICH_MODIF06) = FichierCourant.Modif06

comp = comp + 1

Else

RgDeb.Offset(comp, COL_FICH_NOM) = FichierCourant.Nom

RgDeb.Worksheet.Hyperlinks.Add anchor:=RgDeb.Offset(comp, COL_FICH_NOM), Address:=FichierCourant.Chemin

RgDeb.Offset(comp, COL_FICH_CHEMIN) = FichierCourant.Chemin

RgDeb.Worksheet.Hyperlinks.Add anchor:=RgDeb.Offset(comp, COL_FICH_CHEMIN), Address:=FichierCourant.SousDossHyper

'RgDeb.Offset(ICollec, COL_FICH_DATECREATION) = FichierCourant.DateCreation

RgDeb.Offset(comp, COL_FICH_MODIFDERN) = FichierCourant.ModifDern

'RgDeb.Offset(ICollec, COL_FICH_ACCESDERN) = FichierCourant.AccesDern

RgDeb.Offset(comp, COL_FICH_PROPRIETAIRE) = FichierCourant.Proprietaire

RgDeb.Offset(comp, COL_FICH_TAILLE) = FichierCourant.Taille

comp = comp + 1

End If

If comp = 32000 Then

Call Feuillesuiv(nb)

comp = 1

nb = nb + 1

End If

' If Date_Fic > VBA.Int(VBA.CDate(FichierCourant.ModifDern)) Then

' comp = 0

' MsgBox "Aucun fichier à afficher après cette date"

' End If

Le 26/11/2013 à 14:23

bonjour,

voici comment j'adapterai ce code, sur base de l'info que tu as fournie, à tester

For ICollec = 1 To eCollectionFichier.Count

Set FichierCourant = eCollectionFichier.Item(ICollec)
Set fso = CreateObject("Scripting.FileSystemObject")
strFile = FichierCourant.Chemin
Set fle = fso.GetFile(strFile)
FichierCourant.ModifDern = fle.DateLastModified

If Date_Fic <= VBA.Int(VBA.CDate(FichierCourant.ModifDern)) Then

If VBA.InStr(FichierCourant.Proprietaire, "\") Then

Proprietaire = VBA.Split(FichierCourant.Proprietaire, "\")
RgDeb.Offset(comp, COL_FICH_NOM) = FichierCourant.Nom
RgDeb.Worksheet.Hyperlinks.Add anchor:=RgDeb.Offset(comp, COL_FICH_NOM), Address:=FichierCourant.Chemin
'RgDeb.Offset(ICollec, COL_FICH_TYPE) = FichierCourant.Typ
'RgDeb.Offset(ICollec, COL_FICH_ATTRIB) = FichierCourant.Attrib
RgDeb.Offset(comp, COL_FICH_CHEMIN) = FichierCourant.Chemin
RgDeb.Worksheet.Hyperlinks.Add anchor:=RgDeb.Offset(comp, COL_FICH_CHEMIN), Address:=FichierCourant.SousDossHyper
'RgDeb.Offset(ICollec, COL_FICH_DATECREATION) = FichierCourant.DateCreation
RgDeb.Offset(comp, COL_FICH_MODIFDERN) = FichierCourant.ModifDern
'RgDeb.Offset(ICollec, COL_FICH_ACCESDERN) = FichierCourant.AccesDern
'RgDeb.Offset(ICollec, COL_FICH_PROPRIETAIRE) = FichierCourant.Proprietaire
RgDeb.Offset(comp, COL_FICH_PROPRIETAIRE) = Proprietaire(1)
RgDeb.Offset(comp, COL_FICH_TAILLE) = FichierCourant.Taille
'RgDeb.Offset(ICollec, COL_FICH_SOUSDOSS) = FichierCourant.SousDoss
'RgDeb.Offset(ICollec, COL_FICH_SOUSDOSSRG) = FichierCourant.SousDossRg
'RgDeb.Offset(ICollec, COL_FICH_MODIF30) = FichierCourant.Modif30
'RgDeb.Offset(ICollec, COL_FICH_MODIF06) = FichierCourant.Modif06
comp = comp + 1

Else

RgDeb.Offset(comp, COL_FICH_NOM) = FichierCourant.Nom
RgDeb.Worksheet.Hyperlinks.Add anchor:=RgDeb.Offset(comp, COL_FICH_NOM), Address:=FichierCourant.Chemin
RgDeb.Offset(comp, COL_FICH_CHEMIN) = FichierCourant.Chemin
RgDeb.Worksheet.Hyperlinks.Add anchor:=RgDeb.Offset(comp, COL_FICH_CHEMIN), Address:=FichierCourant.SousDossHyper
'RgDeb.Offset(ICollec, COL_FICH_DATECREATION) = FichierCourant.DateCreation
RgDeb.Offset(comp, COL_FICH_MODIFDERN) = FichierCourant.ModifDern
'RgDeb.Offset(ICollec, COL_FICH_ACCESDERN) = FichierCourant.AccesDern
RgDeb.Offset(comp, COL_FICH_PROPRIETAIRE) = FichierCourant.Proprietaire
RgDeb.Offset(comp, COL_FICH_TAILLE) = FichierCourant.Taille
comp = comp + 1

End If

If comp = 32000 Then

'Call Feuillesuiv(nb)
comp = 1
nb = nb + 1

End If

End If
Next
If comp = 0 And nb = 0 Then

MsgBox "Aucun fichier à afficher après cette date"

End If

Le 26/11/2013 à 15:00

ok merci pour votre aide.

le pb c'est que comp et nb sont initialisés à 1 dans ma déclaration et donc le message n'apparait pas si comp=0 et nb=0.

Le 26/11/2013 à 15:04

alade23 a écrit :
ok merci pour votre aide.
le pb c'est que comp et nb sont initialisés à 1 dans ma déclaration et donc le message n'apparait pas si comp=0 et nb=0.

il faut donc changer ce test et remplacer le 0 par des 1.

Le 26/11/2013 à 15:34

ok, merci

Le 28/11/2013 à 14:55

Je voudrais revenir sur ce point

If comp = 1 And nb = 1 Then

MsgBox "Aucun fichier à afficher après cette date"

else

Msgbox comp -1 & "fichiers trouvés"

mon souci se trouve au niveau du else. quand le nombre de données à afficher dépasse une certaine valeur elles s'affichent sur un page suivante que j'ai défini.le pb c'est qu'au lieu de compter l'ensemble des données de toutes les pages, il ne prend en compte que le calcul de la dernière page. pour résumer le maxi d'une page est comp=32000 lorsqu'il plus d'une page comment gérer le comp -1 sur l'ensemble des pages;

Merci

Le 28/11/2013 à 15:10

alade23 a écrit :
Je voudrais revenir sur ce point
If comp = 1 And nb = 1 Then
MsgBox "Aucun fichier à afficher après cette date"
else
Msgbox comp -1 & "fichiers trouvés"
Merci

par exemple tu remplaces l'instruction msgbox par

msgbox comp-1+(nb-1)*32000 & "fichiers trouvés"

Le 28/11/2013 à 15:38

ça marche nickel, merci beaucoup pour ton aide.

Rechercher des sujets similaires à "probleme code vba gestion dossier"