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
|
Option Explicit
Dim oApp,oConn,Chemin_Excel,Chemin_Access,fsoN,Chemin_Excel_New,Valeur1,Valeur2, fileObjN,Valeur_Site,Valeur_CRB,fs,Valeur_ETS,Valeur_CRB_A,Valeur_Split,Valeur_SITE_A,Valeur_Ligne,moteur,rs,adOpenKeyset , adLockOptimistic, requete,cpt,f,fso,ts,fileObj
Chemin_Excel = InputBox ("Saisir le chemin du fichier Excel d'extraction :" )
Chemin_Excel_New = InputBox ("Saisir le chemin du fichier Excel de reception :" )
Chemin_Access=InputBox (" Saisir le chemin de la base de donnée :")
moteur="Provider=Microsoft.Jet.OLEDB.4.0;Data Source="
adOpenKeyset=3
adLockOptimistic=3
Set oConn = CreateObject("ADODB.Connection")
oConn.Open moteur & Chemin_Access
Set rs = CreateObject("ADODB.Recordset")
rs.Open "TRANSCO", oConn, adOpenKeyset, adLockOptimistic
Const ForReading = 1,ForWriting = 2,TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0
Set fso = CreateObject("Scripting.FileSystemObject")
set fileObj = fso.GetFile(Chemin_Excel)
set f = fileObj.OpenAsTextStream(ForReading, TristateUseDefault)
set fs = fso.OpenTextFile(Chemin_Excel_New, ForWriting,True)
while Not f.AtEndOfStream
Valeur_Ligne=f.ReadLine
Valeur_Split=Split(Valeur_Ligne,";")
Valeur1=Valeur_Split(0)
Valeur2=Valeur_Split(2)
Valeur_Site=MID(Valeur1,2,6)
Valeur_CRB=MID(Valeur2,3,4)
rs.moveFirst
do while not rs.eof
Valeur_CRB_A= rs("CRB")
Valeur_Site_A=rs("SITE")
If (Valeur_Site = Valeur_Site_A) And (Valeur_CRB = Valeur_CRB_A) then
Valeur_ETS=rs("ETS")
'WScript.Echo(Valeur_ETS & ";" & Valeur_Ligne)
fs.WriteLine (Valeur_ETS & ";" & Valeur_Ligne)
End if
rs.movenext
loop
Wend
WScript.Echo("Fini")
fs.Close
f.Close
rs.close
WScript.Quit |
Partager