'#Script "Capture PJ"
'#Version "2010-01-06"
'#Signature "Demo"
'
'On creer la base de donnée
'#Base "Nom,Adresse,CP,Ville,Tel,Fax,Mobile,Email,Site,Description,Activite"
'
Action.doLoop = True
Call Main
'
'Fonction executée a chaque chargement de page
'#Include "chkDoublons.pjs"
'
Public Function doLoop()
	Call Main
End Function
'
Sub Main()
	Set oTags = InternetExplorer(1).Document.All.tags("li")
	For Each oTag In oTags
		Resultats = ""
		If oTag.className = "bpOrd" Then
			If Err.Number = 0 Then
				DecodePJ oTag
			End If
		End If
	Next
	Set oTags = Nothing
	Set oAs = InternetExplorer(1).Document.links
	For Each oA In oAs
		If oA.innerText = "SUIV" And Left(oA.className,13) = "page_suivante" Then
			oA.Click
		End If
	Next
	Set oAs = Nothing
End Sub
'
Public Function DecodePJ(Resultat)
    Set ObjRegex = New RegExp
    ObjRegex.Global = True
    ObjRegex.IgnoreCase = True
    For I = 0 To Resultat.All.length - 1
        'Societe
        If Resultat.All(I).tagName = "STRONG" And Resultat.All(I).parentElement.tagName="H3" Then
            Societe = Trim(Resultat.All(I).InnerText)
        End If
        If (Resultat.All(I).className = "bpInscAdrLib" Or Resultat.All(I).className = "bpInscAdr") And Resultat.All(I).tagName="P" Then
            'Adresse
            Adresse = Resultat.All(I).innerText
            ObjRegex.Pattern = "(.*)([0-9]{5})([^|]*)"
            Set Matches = ObjRegex.Execute(Adresse)
            If Matches.Count > 0 Then
                Set Match = Matches.Item(0)
                Adresse1 = Trim(Match.SubMatches(0))
                Codepostal = Trim(Match.SubMatches(1))
                Ville = Trim(Match.SubMatches(2))
                Replace Adresse, Adresse1, ""
                Replace Adresse, Codepostal, ""
                Replace Adresse, Ville, ""
				Em = Split(Ville,vbCrLf)
				If (uBound(Em)>0) Then
					Mail = Trim(Em(1))
					Mail = Replace(Mail," ","")
					Mail = Replace(Mail,":","")
					Mail = Replace(Mail,"Mail","",vbNull,vbNull,1)
					Mail = lCase(Mail)
				End If
				Ville = Trim(Em(0))
            End If
        End If
        If Resultat.All(I).className = "bpTmod" And Resultat.All(I).tagName="P" Then
			Description = Trim(Resultat.All(I).innerText)
		End If
        If Resultat.All(I).className = "bpAct" And Resultat.All(I).tagName="P" Then
			Activite = Trim(Resultat.All(I).innerText)
			Activite = Trim(Replace(Activite,"Activité :","",vbNull,vbNull,vbTextCompare ))
		End If
        If Resultat.All(I).className = "bpWsite" And Resultat.All(I).tagName="P" Then
			Site = Trim(Resultat.All(I).innerText)
		End If
        If Resultat.All(I).className = "bpInscTel" And Resultat.All(I).tagName="DIV" Then
            'Tel-Fax Mobile
			TelFax = Split(Resultat.All(I).innerText,vbCrLf)
			For A = lBound(TelFax) To uBound(TelFax)
				If uCase(Left(TelFax(A),3)) = "FAX" Then
					Fax = TelFax(A)
					Fax = Replace(Fax,"Fax","",vbNull,vbNull,vbTextCompare)
					Fax = Replace(Fax,":","")
					Fax = Replace(Fax,".","")
					Fax = Trim(Fax)
					TelFax(A) = ""
				ElseIf uCase(Left(TelFax(A),6)) = "MOBILE" Then
					Mobile = TelFax(A)
					Mobile = Replace(Mobile,"MOBILE","",vbNull,vbNull,vbTextCompare)
					Mobile = Replace(Mobile,":","")
					Mobile = Replace(Mobile,".","")
					Mobile = Trim(Mobile)
					TelFax(A) = ""
				Else
	                ObjRegex.Pattern = "(([\d\s]{1,}){1,5})"
					Set Matches = ObjRegex.Execute(TelFax(A))
					If Matches.Count > 0 Then
						Set Match = Matches.Item(0)
						If Match.length > 1 Then
							Tel = Trim(Match.SubMatches(1))
							Tel = Replace(Tel, vbCrLf, "")
						End If
						TelFax(A) = ""
					End If
				End If
			Next
        End If
    Next
	'On replace les abréviations dans la rue
	Adresse1 = Replace (Adresse1," chem "," Chemin ",vbNull,vbNull,vbTextCompare)
	Adresse1 = Replace (Adresse1," av "," Avenue ",vbNull,vbNull,vbTextCompare)
	Adresse1 = Replace (Adresse1," bd "," Boulevard ",vbNull,vbNull,vbTextCompare)
	Adresse1 = Replace (Adresse1," all "," Allées ",vbNull,vbNull,vbTextCompare)
	Adresse1 = Replace (Adresse1," r "," Rue ",vbNull,vbNull,vbTextCompare)
	Adresse1 = Replace (Adresse1," rte "," Route ",vbNull,vbNull,vbTextCompare)
	Adresse1 = Replace (Adresse1," rte "," Route ",vbNull,vbNull,vbTextCompare)
	Adresse1 = Replace (Adresse1," imp "," Impasse ",vbNull,vbNull,vbTextCompare)
	Adresse1 = Replace (Adresse1," rd-pt "," Rond Point ",vbNull,vbNull,vbTextCompare)
	Adresse = uCase(Adresse1)
	Set Record = Base.ListItems.Add(, , CStr(Societe))
	Record.SubItems(1) = CStr(Adresse)
	Record.SubItems(2) = CStr(Codepostal)
	Record.SubItems(3) = CStr(Ville)
	Record.SubItems(4) = CStr(Tel)
	Record.SubItems(5) = CStr(Fax)
	Record.SubItems(6) = CStr(Mobile)
	Record.SubItems(7) = CStr(Mail)
	Record.SubItems(8) = CStr(Site)
	Record.SubItems(9) = CStr(Description)
	Record.SubItems(10) = CStr(Activite)
	If Instr(Tel,"Opposé") > 0 Or Instr(Fax,"Opposé") > 0 Or Instr(Mobile,"Opposé") > 0 Then
		chk = False
	Else
		chk = True
	End If
	Record.Checked = chk
	Base.Refresh
	Set ObjRegex = Nothing
	Set Record = Nothing
	Set Matches = Nothing
	Set Match = Nothing
End Function