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
| Public Sub RecupPage()
Me.Visible = False
R = 0
' cette premiere boucle fonctionne sur tous les ordinateurs
Do While R <= 50
DoEvents
On Error Resume Next
AppActivate "VB 6 et antérieur"
If Err.Number <> 0 Then
On Error GoTo 0
Else
SendKeys "%(A)", True: DoEvents 'Alt+A ouverture du menu Affichage
SendKeys "S", True: DoEvents ' demande d'affichage Source
Exit Do
End If
DoEvents: R = R + 1
Loop
DoEvents
Retard 1
R = 0
Clipboard.Clear
Do While R < 150
On Error Resume Next
AppActivate "forumdisplay["
If Err.Number <> 0 Then
On Error GoTo 0
Else
'******* ICI le jeu de SendKeys ne fonctionne pas sur le portable
SendKeys "^(A)" ' Ctrl+A Selectionner tout
'SendKeys "^{A}", True: DoEvents ' Ctrl+A Selectionner tout
'Retard 0.25
'******* ICI le jeu de SendKeys ne fonctionne pas sur le portable
SendKeys "^(C)" 'Ctrl+C Copier
'SendKeys "^(C)", True: DoEvents 'Ctrl+C Copier
'Retard 0.25
'******* LA le jeu de SendKeys fonctionne sur le portable et les autres ordinateurs
SendKeys "%{F4}", True: DoEvents ' Alt+F4 ferme notpad
Exit Do
End If
DoEvents: R = R + 1
'Retard 0.25
Loop
DoEvents
'fin new
LeTexte = Clipboard.GetText
'Text1 = LeTexte
's'ajit-il du bon texte
TextRech = "<title>VB 6 et antérieur - Forum des développeurs</title>"
PosDeb = InStr(1, LeTexte, TextRech)
Me.Visible = True
If PosDeb = 0 Then
MsgBox "Texte source non conforme", vbInformation
Exit Sub
End If
'recherche de la partie haute a eliminer
TextRech = "<!-- Fin de la modification d'Anomaly -->"
LenTrouver = Len(TextRech)
PosDeb = InStr(1, LeTexte, TextRech)
PosFin = PosDeb + LenTrouver
LenTrouver = Len(LeTexte) - PosFin
LeTexte = Right$(LeTexte, LenTrouver) 'supprime la premiére partie inutile
'recherche de la partie basse a eliminer
'<!-- end show threads -->
TextRech = "<!-- end show threads -->"
PosDeb = InStr(1, LeTexte, TextRech)
LeTexte = Left$(LeTexte, PosDeb) 'supprime la derniére partie inutile
PosDeb = 1
End Sub |
Partager