Excel cercare parole in sito web

[Biespi]

Ciao
Vorrei capire se è possibile che excel possa cercare la presenza di una lista di parole in un sito web e mi restituisca come risultato in una casella una striga di testo con le parole trovate separate da una virgola.

In pratica ho un foglio con un elenco sulle righe di un migliaio di aziende con denominazione, telefono, email, indirizzo, città e sito web, quello che vorrei che nella colonna a fianco comparisse in automatico la striga di testo con le parole della lista, se presenti nel sito

Ho provato con alcuni programmi di scraping, ma non ho trovato quello adatto al mio caso, ci ho provato anche con google sheet con il comando importxml ma senza successo.
Poi mi sono ricordato di excel e può fare molto di più, sarebbe la soluzione ideale, ma onestamente non so usare VB, ho pensato a una macro che in automatico mi scaricasse il file html in una cella e andasse a cercare la presenza delle parole , ma non so se sia possibile.

Grazie

[Marius44]

Ciao
Se ho capito bene quello che vorresti fare, ti dico due cose:
1) prima di postare non hai fatto una ricerca mirata nel Forum;
2) prova a dare uno sguardo qui viewtopic.php?f=26&t=109033

Ciao,
Mario

[Biespi]

grazie mille Mario della risposta! prima di postare ho provato per un oretta a cercare qualcosa, probabilmente dovevo cercare di più e meglio visto che
il link che mi hai indicato sembra proprio quello giusto:-))
Inizio subito a provarlo !
ci metterò un pochino perché non conosco Il visual basic.
a dire il vero avevo iniziato qualcosina 20 25 anni fa ma non mi ricordo più niente.
Grazie ancora e buona serata

[Biespi]

Ciao
Ho provato la Macro, mi ha fatto capire diverse cose sul VB, ma non è quello che mi serve perché questa macro va ad aprire diverse pagine web ognuna con una parola di ricerca diversa che prende dal range B1:B37
Io vorrei che invece cercasse si i termini del range B1:B37, ma in una lista di url:

per esempio nella colonna A potrei avere una lista di centri estetici

http://www.centroesteticomaridea.it/
http://www.corsoveneziaotto.it/
http://www.luciarinaldi.it/

In una colonna, o riga o cella metterei le parole da cercare tipo
Trattamenti
Prodotti
Estetico
Benessere
Medicina
E nella D mettere il risultato della Macro, tipo così



Ho trovato un post interessante, viewtopic.php?t=104406#p609080 che cerca dei termini all’interno di alcune pagine htm in locale, quindi per farlo cercare sul web invece di mettere il percorso locale, ho inserito nella casella B1 direttamente l’url.
Ma si blocca a questa istruzione myF = Dir(myPath & "*." & myType) che penso vada modificata, ma non so come.

Questa è la macro

Codice: Seleziona tutto

Sub findStr()
Dim IFound, I As Long, myF As String, myPath As String, myType As String, LastA As Long
'
myPath = Range("B1") & "\"
myType = Range("B2") & "*"
'
LastA = Cells(Rows.Count, 1).End(xlUp).Row
'
If Mid(myPath, 2, 1) = ":" Then ChDrive Left(myPath, 1)
myF = Dir(myPath & "*." & myType)
Application.EnableEvents = False
With ThisWorkbook.ActiveSheet
    While myF <> ""
        Application.ScreenUpdating = True: DoEvents
        .Range("B4") = .Range("B4") + 1
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False
        Workbooks.Open myPath & myF
        Application.DisplayAlerts = True
        For I = 8 To LastA
        mylook = .Cells(I, 1).Value
            Set IFound = ActiveSheet.Cells.Find(what:=mylook, LookIn:=xlValues, LookAt:=xlPart)
            If Not IFound Is Nothing Then
                .Cells(Rows.Count, 4).End(xlUp).Offset(1, 0) = myPath & myF
                .Range("B5") = .Range("B5") + 1
                Exit For
            End If
        Next I
        ActiveWorkbook.Close False
    myF = Dir
    Wend
End With
Application.EnableEvents = True
MsgBox ("Completato")
End Sub


Mi scuso in anticipo se ho sbagliato qualcosa nella forma del post.
Grazie

[Anthony47]

Ho provato la Macro, mi ha fatto capire diverse cose sul VB, ma non è quello che mi serve

Eh, lo sapevo...

Il problema e' che le tue parole potrebbero essere in qualsiasi pagina del sito; mentre google scansiona ogni pagina e ogni link sottostante con un algoritmo messo a punto in "qualche anno di esperienza" le mie macro si limitano a leggere pagine ben precise che potrebbero contenere anche solo qualche foto accattivante e i link alle pagine sottostanti.
Con questo limite non secondario ti propongo questo codice:

Codice: Seleziona tutto

Sub Main()
Dim Cioppa, I As Long, lastA As Long
'
Sheets("Foglio1").Select        '<<< Il foglio con gli Url
'
lastA = Cells(Rows.Count, 1).End(xlUp).Row
Range("B2").Resize(lastA + 10, 250).ClearContents
For I = 2 To lastA
Cells(I, 1).Select: DoEvents
    Cioppa = CercaWord(Cells(I, 1), Sheets("Foglio2").Range("A2:A100"))
    Cells(I, 2).Resize(1, UBound(Cioppa)).Value = Cioppa
Next I
MsgBox ("Completato...")
End Sub

Function CercaWord(ByVal myURL As String, ByRef myWD As Range) As Variant
Dim HTDoc As Object, htmTxt As String
Dim I As Long, K As Long, myC As Range, oArr()
'
Set HTDoc = CreateObject("HTMLfile") 'late binding alla html obj lib
'0
On Error Resume Next
With CreateObject("WINHTTP.WinHTTPRequest.5.1")
    .Open "GET", myURL, False
    .send
    CallByName HTDoc, "Write", VbMethod, .responsetext
End With
On Error GoTo 0
htmTxt = HTDoc.getelementsbytagname("body")(0).innertext
ReDim oArr(1 To myWD.Cells.Count)
For Each myC In myWD
    If myC.Value <> "" Then
        If InStr(1, htmTxt, myC.Value, vbTextCompare) > 0 Then
            K = K + 1
            oArr(K) = myC.Value
        End If
    End If
Next myC
If K = 0 Then K = 1
ReDim Preserve oArr(1 To K)
CercaWord = oArr
Set HTDoc = Nothing
End Function

Va messo in un Modulo standard del vba.

Questo codice presuppone che gli url (completi di http/https) siano inseriti in Foglio1 da A2 verso il basso, e le parole da cercare siano in Foglio2-A2:A100
Quando sei pronto devi lanciare la Sub Main:
-partendo da Excel, premi Alt-F8; scegli Main dall'elenco di macro disponibili, premi Esegui

Su Foglio1, le colonne da B verso destra saranno AZZERATE SENZA PREAVVISO all'avvio della Sub Main, prima di essere compilate con le sole keyword trovate sulla pagina web.

Prova e fai sapere...

[Biespi]

Wow !
Anzi wow wow wow
Sei un genio la tua macro è fantastica ! Velocissima !
Troppo bello vedere come ogni riga si popoli con le parole che stavo cercando.
Incredibile !
E' cosi bella che la continuo far andare con gli stessi dati, e' uno spettacolo
Non so come ringraziarti

Riguardo le parole da cercare, si hai ragione potrebbero essere in qualsiasi pagina e non solo nella home, ma ho verificato che nell 80% dei casi sono presenti anche nella home e mi può andare bene

Grazie
Sei un mito !

[Biespi]

La macro cerca giustamente le parole all’interno del tag body, mi stavo chiedendo se è possibile farle cercare in tutto il codice html ? in questo modo si possono cercare non solo eventuali keywords nei meta tags title, keywords e description, ma anche in tutto il listato html.
nell' istruzione
htmTxt = HTDoc.getelementsbytagname("body")(0).innertext
Ho provato mettere al posto di body, il tag “html” e anche “*”, ma cosi non trova neanche le parole che normalmente trova nel body.
Sapete come mai ?
Grazie

[Anthony47]

Allora userai innerHTML invece di innertext:

Codice: Seleziona tutto

htmTxt = HTDoc.getelementsbytagname("body")(0).innerHTML  ' .innertext

Pero' secondo me questo allunghera' notevolmente la durata della ricerca e non intravedo nessuna utilita'

Ciao

[Biespi]

Grazie mille !

[Biespi]

Grazie ancora Anthony, effetivamente cercendo in tutto il codice il processo è più lungo, trova ogni tanto qualche parola in più, ma meno di quanto mi aspettassi.
Volevo chiedervi se si può inserire in questa macro la possibilità di copiare il title, meta description e meta keywords nelle colonne adiacenti all url o bisogna creare una macro diversa

Grazie

[Anthony47]

Volevo chiedervi se si può inserire in questa macro la possibilità di copiare il title, meta description e meta keywords nelle colonne adiacenti

Con riferimento (ad esempio) al sorgente di http://www.centroesteticomaridea.it puoi specificare a quali informazioni fai riferimento?

[Biespi]

Certo !
Sito:http://www.centroesteticomaridea.it
<title>Estetica Benessere Milano - Centro Estetico Maridea</title>
<meta name="description" content="Estetica Benessere Milano - Centro Estetico Maridea, centro estetico Maridea in Zona Duomo a Milano, trattamenti Corpo Milano"/>

qui manca il meta name keywords, che non è stato messo (in molti non lo mettono da quando google ha detto di non utilizzarlo più per la SERP)


Un sito che li ha tutti e tre è questo
https://www.centroesteticogiusyeserse.it/

riga 230
<title> Massaggi linfodrenanti | Milano, MI | Centro Estetico Giusy &amp; Serse </title>
<meta name="keywords" content="massaggi linfodrenanti, elettrolipolisi"/>
<meta name="description" content="Se è alla ricerca di massaggi linfodrenanti ed elettrolipolisi eseguiti da professionisti a Milano, si affidi al Centro Estetico Giusy &amp; Serse."/>

[Anthony47]

Allora, riserviamo le colonne B-C-D a questi nuovi parametri (rispettivamente Title, Description, Keywords) e inseriremo le parole pilota da col E in avanti.
Va modificata la Function CercaWord come segue:

Codice: Seleziona tutto

Function CercaWord(ByVal myURL As String, ByRef myWD As Range) As Variant
Dim HTDoc As Object, htmTxt As String
Dim I As Long, K As Long, myC As Range, oArr()
'
Set HTDoc = CreateObject("HTMLfile") 'late binding alla html obj lib
'0
On Error Resume Next
With CreateObject("WINHTTP.WinHTTPRequest.5.1")
    .Open "GET", myURL, False
    .send
    CallByName HTDoc, "Write", VbMethod, .responsetext
End With
On Error GoTo 0
htmTxt = HTDoc.getElementsByTagName("body")(0).innerText
'htmTxt = HTDoc.getElementsByTagName("body")(0).innerHTML
ReDim oArr(1 To myWD.Cells.Count + 3)
K = 3
For Each myC In myWD
    If myC.Value <> "" Then
        If InStr(1, htmTxt, myC.Value, vbTextCompare) > 0 Then
            K = K + 1
            oArr(K) = myC.Value
        End If
    End If
Next myC
oArr(1) = HTDoc.getElementsByTagName("title")(0).innerText
Dim mColl As Object, mItm As Object
Set mColl = HTDoc.getElementsByTagName("meta")
For Each mItm In mColl
Debug.Print mItm.outerHTML
    If InStr(1, mItm.outerHTML, "=keyword", vbTextCompare) > 0 Then
        oArr(3) = mItm.getAttribute("content")
    ElseIf InStr(1, mItm.outerHTML, "=description", vbTextCompare) > 0 Then
        oArr(2) = mItm.getAttribute("content")
    End If
Next mItm
If K = 0 Then K = 1
ReDim Preserve oArr(1 To K)
CercaWord = oArr
Set HTDoc = Nothing
End Function


Ciao

[Biespi]

Siiiii
Perfetta !
Non ho parole, grazie mille!!!!

Anthony ti auguro una bellissima giornata, almeno pari a quella che ho iniziato a vivere io grazie alla tua bellissima Macro !

grazie ancora

[Biespi]

Ciao a tutti
la Macro va benissimo, grazie ancora Anthony, ho un altra domanda, ma questa lo so è assurda e penso non fattibile, ma ci provo lo stesso a chiederlo:
Vorrei per ogni per ogni sito salvare l'immagine del logo dell 'attività, ma siccome sulle pagine web si può trovare dovunque sul sito e chiamarsi in 1000 modi diversi non è fattibile. Ho pensato però che quasi tutti i siti hanno una pagina FB dedicata dove mettono sempre il logo nella foto di profilo.
La mia domanda è secondo voi la macro quando va sul sito può cercare il link della pagina facebook seguirlo e scaricare l'immagine del profilo ?

Grazie