1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95
| Dim courant, temp_attente
courant = "C:\envoi\attente_echantillon\"
ShowFolderList(courant)
Function ShowFolderList(strPath)
Const ForReading = 1, ForWriting = 2
Dim objFso, colFile, objTextStream, objTextFile
Dim strLine, nom_fichier, extension, nom_ss_date, date_f, loc_date
Dim fichier_gestion, num_fich, i, loc_gestion, loc_gestion2, dossier_dest
Set objFso = CreateObject("Scripting.FileSystemObject")
For Each colFile in objFso.GetFolder(strPath).Files
If LCase(objFso.GetExtensionName(colFile.Name)) = "txt"
Then
num_fich = 0
nom_fichier = Ucase(objFso.GetBaseName(colFile.Name))
date_f = Right(nom_fichier, 14)
loc_date = InStr(nom_fichier, date_f)
nom_ss_date = Left(nom_fichier, loc_date - 1)
loc_gestion = InStr(LCase(nom_fichier), "gestion")
extension = "." & objFso.GetExtensionName(colFile.Name)
fichier_gestion = nom_ss_date & "gestion" & extension
If loc_gestion = 0 Then
If Len(Int(date_f)) = 14 Then
Dim annee, mois, jour, heure, min, sec
date_1 = Split(Date, "/")
jour = date_1(0)
mois = date_1(1)
annee = date_1(2)
date_2 = Split(time, ":")
heure = date_2(0)
min = date_2(1)
sec = date_2(2)
date_3 = Int(annee & mois & jour & heure & min & sec)
'Recuperation heure + date du fichier
locheure = Mid(date_f, 9, 2)
locdate = Mid(date_f, 7, 2)
'Recuperation heure + date du PC
locheure3 = Mid(date_3, 9,2)
locdate3 = Mid(date_3, 7,2)
'Si la date du fichier n'est pas egale a 30 ou 31 et la date du PC n'est pas egale à 1
If (locdate <> 30 or 31) and locdate3 <> 1 Then
If Int(date_f) < date_3 - 1000000 Then
If InStr(UCase(nom_fichier), "_MP_") Then
objFso.DeleteFile courant & nom_fichier & extension
Else
If InStr(UCase(nom_fichier),"_CE_") Then
dossier_dest = "C:\envoi\incomplets\centrale_mesure\"
Elseif Instr(LCase(nom_fichier),"_ce_") Then
dossier_dest = "C:\envoi\incomplets\centrale_mesure\"
Elseif InStr(UCase(nom_fichier),"_ME_") Then
dossier_dest = "C:\envoi\incomplets\metrologie\"
Elseif InStr(LCase(nom_fichier),"_me_") Then
dossier_dest = "C:\envoi\incomplets\metrologie\"
Elseif Instr(UCase(nom_fichier),"_3D_") Then
dossier_dest = "C:\envoi\incomplets\3D\"
Elseif Instr(LCase(nom_fichier),"_3d_") Then
dossier_dest = "C:\envoi\incomplets\3D\"
ElseIf Instr(LCase(nom_fichier),"pivot_ms_") Then
dossier_dest = "C:\envoi\incomplets\Autres\"
Else
dossier_dest = "C:\envoi\incomplets\Autres\"
End If
objFso.MoveFile courant &
nom_fichier & extension, dossier_dest
End If
If objFso.FileExists
(courant & nom_ss_date & "gestion" & extension) Then
objFso.DeleteFile
courant & nom_ss_date & "gestion" & extension
End If
End If
Else
'Call MsgBox("Date
incorrecte sur le fichier " & nom_fichier)
End If
End If
End If
End If
Next
End Function |
Partager