Excel Forum - Porady, Pomoc,  Excel Help, Excel FAQ Strona Główna
 FAQ  RegulaminRegulamin  Szukaj   Użytkownicy   Grupy   Rejestracja   Profil   Twoje wiadomości   Zaloguj 


Poprzedni temat «» Następny temat
ID tematu: 68623 Skopiuj do schowka sprawdzenie modelu telefonu po IMEI
Autor Wiadomość
Marcindworzan
Stały bywalec Excelforum


Wersja: Win Office 2010
Posty: 308
Wysłany: 30-07-2020, 17:21   sprawdzenie modelu telefonu po IMEI

Witam,
w załączniku umieściłem plik, w którym zastosowano algorytm dopisywania ostatniej cyfry w numerze IMEI (suma kontrolna). W jaki sposób mógłbym za pomocą makro sprawdzić jaki model przypisany jest do danego numeru IMEI z komórki B2? aby przekierowywało mnie na stronę www z wynikiem

(np. 'simlock24.pl/imei_chk')

Edycja:
Na podst. pkt. 1.2 Regulaminu

ąćęłńóś

albo - o ile to możliwe - dane wpisywało w jakąś komórkę (np. A3), bez konieczności otwierania strony?
Z góry dziękuję za pomoc.

Przykład.xlsm
Pobierz Plik ściągnięto 12 raz(y) 21.19 KB

ID posta: 390328 Skopiuj do schowka
 
 
Marecki 
Excel Expert



Wersja: Win Office 2019
Pomógł: 2432 razy
Posty: 7975
Wysłany: 30-07-2020, 21:42   

Testuj i dopasuj sobie procedurę do danych w arkuszu.
Kod:
Sub Test()
'Włącz referencje do Microsoft HTML Object Library
    Dim oHtml As HTMLDocument
    Dim msXML As Object
    Dim Resp As String
    Dim sImei As String
    Dim Ans, el, Tel

    sImei = "864262048415021"

    Set oHtml = New HTMLDocument
    Set msXML = CreateObject("MSXML2.ServerXMLHTTP.6.0")

    With msXML
        .Open "POST", "https://simlock24.pl/imei_chk/", False
        .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
        .Send ("imei=" & sImei)
        .waitforresponse
        oHtml.body.innerhtml = .ResponseText
    End With

    Ans = oHtml.getElementsByClassName("col-lg-8")

    For Each el In Ans.all
        If el.innerText Like "ODBLOKUJ*" Then
            Tel = Split(el.innerText, vbCrLf)(1)
            Exit For
        End If
    Next el
   
    If Tel = "" Then Tel = "Nie znaleźliśmy telefonu"
   
MsgBox Tel

End Sub
_________________
Hardware - ta część komputera, którą można kopnąć kiedy software przestanie funkcjonować.

Szkolenia z Excela , FB
Office 2019 Professional Plus , Windows 10 x64
Pozdrawiam, były mkkk23 teraz Marecki.
ID posta: 390331 Skopiuj do schowka
 
 
umiejead 
Excel Expert


Wersja: Win Office 2013
Pomógł: 720 razy
Posty: 3878
Wysłany: 31-07-2020, 08:08   

Strona działa - kod nie (tzn. działa ale nie wyszukuje modelu :-/ ).
Tak czy siak upewnij się czy masz włączoną referencję Microsoft HTML Object Library w VBA.
.
_________________
.
Jak poprawnie opisać problem: http://www.excelforum.pl/...ika-vt59262.htm
Chcesz precyzyjną odpowiedź - zadaj precyzyjne pytanie.
ID posta: 390334 Skopiuj do schowka
 
 
Marecki 
Excel Expert



Wersja: Win Office 2019
Pomógł: 2432 razy
Posty: 7975
Wysłany: 31-07-2020, 08:45   

umiejead, a na tej stronie https://simlock24.pl/imei_chk/ jak podasz swój IMEI to podaje Ci markę telefonu ?

Załącznik do testów. Mi działa. ;-)

Telefon.xlsm
Pobierz Plik ściągnięto 13 raz(y) 27.7 KB

_________________
Hardware - ta część komputera, którą można kopnąć kiedy software przestanie funkcjonować.

Szkolenia z Excela , FB
Office 2019 Professional Plus , Windows 10 x64
Pozdrawiam, były mkkk23 teraz Marecki.
ID posta: 390338 Skopiuj do schowka
 
 
umiejead 
Excel Expert


Wersja: Win Office 2013
Pomógł: 720 razy
Posty: 3878
Wysłany: 31-07-2020, 10:52   

Tak.
Kod:
357342085813694

Cytat:
Nokia TA-1010
_________________
.
Jak poprawnie opisać problem: http://www.excelforum.pl/...ika-vt59262.htm
Chcesz precyzyjną odpowiedź - zadaj precyzyjne pytanie.
ID posta: 390354 Skopiuj do schowka
 
 
Marcindworzan
Stały bywalec Excelforum


Wersja: Win Office 2010
Posty: 308
Wysłany: 31-07-2020, 12:41   

@Marecki - sprawdziłem Twój załącznik i wpisałem swój IMEI - niestety nie znalazło. Wpisałem IMEI podany przez @umiejead - również nie znalazło. Na stronie www modele odnajduje, więc w czym może tkwić problem?
ID posta: 390357 Skopiuj do schowka
 
 
umiejead 
Excel Expert


Wersja: Win Office 2013
Pomógł: 720 razy
Posty: 3878
Wysłany: 31-07-2020, 12:48   

Może na innej stronie? (Google > "check imei")?
.
_________________
.
Jak poprawnie opisać problem: http://www.excelforum.pl/...ika-vt59262.htm
Chcesz precyzyjną odpowiedź - zadaj precyzyjne pytanie.
ID posta: 390358 Skopiuj do schowka
 
 
Marcindworzan
Stały bywalec Excelforum


Wersja: Win Office 2010
Posty: 308
Wysłany: 31-07-2020, 12:56   

wybrałem stronę simlock, gdyż nie ma ona zabezpieczenia captcha, inne niestety mają..
ID posta: 390359 Skopiuj do schowka
 
 
umiejead 
Excel Expert


Wersja: Win Office 2013
Pomógł: 720 razy
Posty: 3878
Wysłany: 31-07-2020, 13:22   

https://eimei24.com/imei_warranty/
_________________
.
Jak poprawnie opisać problem: http://www.excelforum.pl/...ika-vt59262.htm
Chcesz precyzyjną odpowiedź - zadaj precyzyjne pytanie.
ID posta: 390361 Skopiuj do schowka
 
 
Marcindworzan
Stały bywalec Excelforum


Wersja: Win Office 2010
Posty: 308
Wysłany: 31-07-2020, 13:27   

@umiejead - strona super - tylko, że nie umiem podmienić jej w kodzie vba w pliku od Mareckiego
ID posta: 390362 Skopiuj do schowka
 
 
umiejead 
Excel Expert


Wersja: Win Office 2013
Pomógł: 720 razy
Posty: 3878
Wysłany: 31-07-2020, 13:33   

Czekaj na @Mareckiego... :mrgreen:
.
_________________
.
Jak poprawnie opisać problem: http://www.excelforum.pl/...ika-vt59262.htm
Chcesz precyzyjną odpowiedź - zadaj precyzyjne pytanie.
ID posta: 390363 Skopiuj do schowka
 
 
Marecki 
Excel Expert



Wersja: Win Office 2019
Pomógł: 2432 razy
Posty: 7975
Wysłany: 31-07-2020, 20:35   

Zmień funkcje na taką:
Kod:
Function Tel_po_imei(sImei As String)
'Włącz referencje do Microsoft HTML Object Library
    Dim oHtml As HTMLDocument
    Dim msXML As Object
    Dim Resp As String
    Dim Ans, el, Tel


    On Error GoTo Tel_po_imei_Error

    Set oHtml = New HTMLDocument
    Set msXML = CreateObject("MSXML2.ServerXMLHTTP.6.0")

    With msXML
        .SetTimeouts 9000, 9000, 9000, 9000
        .Open "POST", "https://simlock24.pl/imei_chk/", False
        .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
        .Send ("imei=" & sImei)
        .waitforresponse
        oHtml.body.innerhtml = .ResponseText
    End With

    Ans = Split(oHtml.getElementsByClassName("col-lg-8")(0).innerText, vbCrLf)(0)

        If Ans Like "*elefon jako*" Then
        Tel = VBA.Mid$(Ans, VBA.InStr(1, Ans, "elefon jako ") + 12, VBA.Len(Ans))
        End If
       
    Set oHtml = Nothing
    Set msXML = Nothing

    If Tel = "" Then
        Tel_po_imei = "Nie znaleźliśmy telefonu, bądź błędnie podany IMEI."
    Else
        Tel_po_imei = Tel
    End If

    On Error GoTo 0
    Exit Function

Tel_po_imei_Error:

    Tel_po_imei = "Nie jestem w stanie podać modelu Twojego telefonu. :-(" & vbNewLine & "Sprawdź jeszcze raz numer IMEI."

End Function
I daj znać.
_________________
Hardware - ta część komputera, którą można kopnąć kiedy software przestanie funkcjonować.

Szkolenia z Excela , FB
Office 2019 Professional Plus , Windows 10 x64
Pozdrawiam, były mkkk23 teraz Marecki.
ID posta: 390372 Skopiuj do schowka
 
 
Marcindworzan
Stały bywalec Excelforum


Wersja: Win Office 2010
Posty: 308
Wysłany: 31-07-2020, 20:53   

@Marecki - genialnie, działa :) bardzo dziękuję za pomoc!
ID posta: 390374 Skopiuj do schowka
 
 
Wyświetl posty z ostatnich:   
Odpowiedz do tematu
Nie możesz pisać nowych tematów
Nie możesz odpowiadać w tematach
Nie możesz zmieniać swoich postów
Nie możesz usuwać swoich postów
Nie możesz głosować w ankietach
Nie możesz załączać plików na tym forum
Możesz ściągać załączniki na tym forum
Dodaj temat do Ulubionych
Wersja do druku

Skocz do:  

Powered by phpBB modified by Przemo © 2003 phpBB Group
Theme xandgreen created by spleen& Programosy modified v0.3 by warna
Opieka techniczna www.marketingNET.pl

Archiwum

Strona używa plików cookies.

Kliknij tutaj, żeby dowiedzieć się jaki jest cel używania cookies oraz jak zmienić ustawienia cookie w przeglądarce.
Korzystając ze strony użytkownik wyraża zgodę na używanie plików cookies, zgodnie z bieżącymi ustawieniami przeglądarki.
Sprawdź, w jaki sposób przetwarzamy dane osobowe