• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

E-SGK uygulamalarına hızlı giriş yapabilmek için uygulama

Z

zeynelhug

Katılım
23 Mart 2019
Mesajlar
32
Excel Vers. ve Dili
Ofis 2016 TR - Türkçe
Arkadaşlar,
Merhabalar,

Excel üzerinde imacros yazılımını kullanarak E-SGK uygulamalarına hızlı giriş yapabilmek için bir makro oluşturdum. Fakat bir sorun ile karşılaştım.

Ben iMacrosu kullanarak SGK uygulamalarına giriş yaparken istenen güvenlik kodunu otomatik olarak yazdırmak istiyorum. Bunun için bir uygulama buldum. Yalnız şöyle bir sorun var.

1- iMacros sgk sitesinden güvenlik kodunu belirlediğim klasöre kaydediyor.
2- Vba kodum ise o resmi .dll yardımı ile okuyor ve bir txt dosyasına kaydediyor.
3- Vba kodum daha sonra o txt dosyasında yazan veriyi istediğim yere işliyor.

Sorun şu ki; Bu süreçte daha önce indirmiş olduğu güvenlik kodunu istediğim yere yazıyor. Yeni indirilen güvenlik kodunu txt dosyasına yazmıyor.
Bunu nasıl çözebilirim.

Kod: 
Public LeerCaptcha As String

Sub GenerarTXT()
On Error Resume Next
Kill ThisWorkbook.Path & "\tessdata\luisrojas.txt"
      Shell ThisWorkbook.Path & "\modulo.dll " & ThisWorkbook.Path & "\mi_imagen.jpg " & ThisWorkbook.Path & "\tessdata\luisrojas", vbNormal
End Sub

Kod: 
Sub LeerArchivoTexto()

    Dim contador As Byte, Ruta$
voy:
    Ruta = Dir(ThisWorkbook.Path & "\tessdata\luisrojas.txt")
    If Ruta = "" And contador < 5 Then

        contador = contador + 1
        GoTo voy
    End If
    
    Open ThisWorkbook.Path & "\tessdata\luisrojas.txt" For Input As #1
    While Not EOF(1)
        Line Input #1, LeerCaptcha
        LeerCaptcha = UCase(LeerCaptcha)
        LeerCaptcha = Replace(LeerCaptcha, "     ", "")
        LeerCaptcha = Replace(LeerCaptcha, "    ", "")
        
        LeerCaptcha = Replace(LeerCaptcha, "   ", "")
        LeerCaptcha = Replace(LeerCaptcha, "  ", "")
        LeerCaptcha = Replace(LeerCaptcha, " ", "")
        LeerCaptcha = Replace(LeerCaptcha, Chr(13), "")
        LeerCaptcha = Replace(LeerCaptcha, Chr(34), "")
        LeerCaptcha = Replace(LeerCaptcha, "/", "")
        LeerCaptcha = Replace(LeerCaptcha, "(", "")
        LeerCaptcha = Replace(LeerCaptcha, ")", "")
        LeerCaptcha = Replace(LeerCaptcha, "[", "")
        LeerCaptcha = Replace(LeerCaptcha, "]", "")
        LeerCaptcha = Replace(LeerCaptcha, "|", "")
        LeerCaptcha = Replace(LeerCaptcha, ">", "")
        LeerCaptcha = Replace(LeerCaptcha, "<", "")
        LeerCaptcha = Replace(LeerCaptcha, ",", "")
        LeerCaptcha = Replace(LeerCaptcha, ".", "")
        LeerCaptcha = Replace(LeerCaptcha, ":", "")
        LeerCaptcha = Replace(LeerCaptcha, ";", "")
        LeerCaptcha = Replace(LeerCaptcha, "_", "")
        LeerCaptcha = Replace(LeerCaptcha, "-", "")
        LeerCaptcha = Replace(LeerCaptcha, "Ã", "")
        LeerCaptcha = Replace(LeerCaptcha, "Â", "")
        LeerCaptcha = Replace(LeerCaptcha, "Å", "")
        LeerCaptcha = Replace(LeerCaptcha, "€", "")
        LeerCaptcha = Replace(LeerCaptcha, "Î", "")
        LeerCaptcha = Replace(LeerCaptcha, "?", "")
        LeerCaptcha = Replace(LeerCaptcha, "¿", "")
        LeerCaptcha = Replace(LeerCaptcha, "@", "")
        LeerCaptcha = Replace(LeerCaptcha, "*", "")
        LeerCaptcha = Replace(LeerCaptcha, "Ï", "")
        LeerCaptcha = Replace(LeerCaptcha, "¬", "")
        LeerCaptcha = Replace(LeerCaptcha, "ƒ", "")
        LeerCaptcha = Replace(LeerCaptcha, "!", "")
        LeerCaptcha = Replace(LeerCaptcha, "!", "")
        LeerCaptcha = Replace(LeerCaptcha, "‰", "")
        LeerCaptcha = Replace(LeerCaptcha, "'", "")
        LeerCaptcha = Replace(LeerCaptcha, "®", "")
        LeerCaptcha = Replace(LeerCaptcha, "‡", "")
        LeerCaptcha = Replace(LeerCaptcha, "", "")
        LeerCaptcha = Replace(LeerCaptcha, vbCrLf, "")
        LeerCaptcha = Replace(LeerCaptcha, vbCr, "")
        LeerCaptcha = Replace(LeerCaptcha, Chr(13), "")
        LeerCaptcha = Replace(LeerCaptcha, Chr(10), "")
    Wend
    Close #1
End Sub

Kod: 
Private Sub CommandButton1_Click()

On Error Resume Next

Set s1 = Worksheets("Şube_Listesi")

subeara = s1.Range("B:B").Find(ComboBox1.Value).Row

tc = s1.Cells(subeara, 13).Value
ekno = s1.Cells(subeara, 14).Value
sistemsifre = s1.Cells(subeara, 15).Value
isyerisifre = s1.Cells(subeara, 16).Value

Set s2 = Worksheets("SGK_Uygulama_Listesi")

uygulamaara = s2.Range("A:A").Find(ComboBox2.Value).Row
aurl = s2.Cells(uygulamaara, 2).Value
atc = s2.Cells(uygulamaara, 3).Value
aekno = s2.Cells(uygulamaara, 4).Value
asistemsifre = s2.Cells(uygulamaara, 5).Value
aisyerisifre = s2.Cells(uygulamaara, 6).Value
aisyeriguvenlik = s2.Cells(uygulamaara, 7).Value

Dim iim, status
Set iim = CreateObject("imacros")
status = iim.iimOpen("")

Dim macro
macro = "VERSION BUILD=10022823" + vbNewLine
macro = macro + "TAB T=1" + vbNewLine
macro = macro + "TAB CLOSEALLOTHERS" + vbNewLine
macro = macro + "URL GOTO=" & aurl & vbNewLine
Kill ThisWorkbook.Path & "\tessdata\luisrojas.txt"
macro = macro + "ONDOWNLOAD FOLDER=" & ThisWorkbook.Path & " FILE=mi_imagen.jpg" + vbNewLine
macro = macro + "TAG POS=1 TYPE=IMG FORM=NAME:formA ATTR=HREF:""https://uyg.sgk.gov.tr/SigortaliTescil/PG"" CONTENT=EVENT:SAVE_ELEMENT_SCREENSHOT" + vbNewLine
macro = macro + "WAIT SECONDS=5" + vbNewLine
macro = macro + "TAG POS=1 TYPE=INPUT:TEXT FORM=NAME:formA ATTR=NAME:" & atc & " Content = " & tc & vbNewLine
macro = macro + "TAG POS=1 TYPE=INPUT:TEXT FORM=NAME:formA ATTR=NAME:" & aekno & " Content = " & ekno & vbNewLine
macro = macro + "TAG POS=1 TYPE=INPUT:PASSWORD FORM=NAME:formA ATTR=NAME:" & asistemsifre & " Content = " & sistemsifre & vbNewLine
macro = macro + "TAG POS=1 TYPE=INPUT:PASSWORD FORM=NAME:formA ATTR=NAME:" & aisyerisifre & " Content = " & isyerisifre & vbNewLine
LeerArchivoTexto
macro = macro + "TAG POS=1 TYPE=INPUT:TEXT FORM=NAME:formA ATTR=NAME:" & aisyeriguvenlik & " Content = " & LeerCaptcha & vbNewLine

status = iim.iimPlayCode(macro)

End Sub
 
zeynelhug' Alıntı:
Arkadaşlar,
Merhabalar,

Excel üzerinde imacros yazılımını kullanarak E-SGK uygulamalarına hızlı giriş yapabilmek için bir makro oluşturdum. Fakat bir sorun ile karşılaştım.

Ben iMacrosu kullanarak SGK uygulamalarına giriş yaparken istenen güvenlik kodunu otomatik olarak yazdırmak istiyorum. Bunun için bir uygulama buldum. Yalnız şöyle bir sorun var.

1- iMacros sgk sitesinden güvenlik kodunu belirlediğim klasöre kaydediyor.
2- Vba kodum ise o resmi .dll yardımı ile okuyor ve bir txt dosyasına kaydediyor.
3- Vba kodum daha sonra o txt dosyasında yazan veriyi istediğim yere işliyor.

Sorun şu ki; Bu süreçte daha önce indirmiş olduğu güvenlik kodunu istediğim yere yazıyor. Yeni indirilen güvenlik kodunu txt dosyasına yazmıyor.
Bunu nasıl çözebilirim.

Kod: 
Public LeerCaptcha As String

Sub GenerarTXT()
On Error Resume Next
Kill ThisWorkbook.Path & "\tessdata\luisrojas.txt"
      Shell ThisWorkbook.Path & "\modulo.dll " & ThisWorkbook.Path & "\mi_imagen.jpg " & ThisWorkbook.Path & "\tessdata\luisrojas", vbNormal
End Sub

Kod: 
Sub LeerArchivoTexto()

    Dim contador As Byte, Ruta$
voy:
    Ruta = Dir(ThisWorkbook.Path & "\tessdata\luisrojas.txt")
    If Ruta = "" And contador < 5 Then

        contador = contador + 1
        GoTo voy
    End If
   
    Open ThisWorkbook.Path & "\tessdata\luisrojas.txt" For Input As #1
    While Not EOF(1)
        Line Input #1, LeerCaptcha
        LeerCaptcha = UCase(LeerCaptcha)
        LeerCaptcha = Replace(LeerCaptcha, "     ", "")
        LeerCaptcha = Replace(LeerCaptcha, "    ", "")
       
        LeerCaptcha = Replace(LeerCaptcha, "   ", "")
        LeerCaptcha = Replace(LeerCaptcha, "  ", "")
        LeerCaptcha = Replace(LeerCaptcha, " ", "")
        LeerCaptcha = Replace(LeerCaptcha, Chr(13), "")
        LeerCaptcha = Replace(LeerCaptcha, Chr(34), "")
        LeerCaptcha = Replace(LeerCaptcha, "/", "")
        LeerCaptcha = Replace(LeerCaptcha, "(", "")
        LeerCaptcha = Replace(LeerCaptcha, ")", "")
        LeerCaptcha = Replace(LeerCaptcha, "[", "")
        LeerCaptcha = Replace(LeerCaptcha, "]", "")
        LeerCaptcha = Replace(LeerCaptcha, "|", "")
        LeerCaptcha = Replace(LeerCaptcha, ">", "")
        LeerCaptcha = Replace(LeerCaptcha, "<", "")
        LeerCaptcha = Replace(LeerCaptcha, ",", "")
        LeerCaptcha = Replace(LeerCaptcha, ".", "")
        LeerCaptcha = Replace(LeerCaptcha, ":", "")
        LeerCaptcha = Replace(LeerCaptcha, ";", "")
        LeerCaptcha = Replace(LeerCaptcha, "_", "")
        LeerCaptcha = Replace(LeerCaptcha, "-", "")
        LeerCaptcha = Replace(LeerCaptcha, "Ã", "")
        LeerCaptcha = Replace(LeerCaptcha, "Â", "")
        LeerCaptcha = Replace(LeerCaptcha, "Å", "")
        LeerCaptcha = Replace(LeerCaptcha, "€", "")
        LeerCaptcha = Replace(LeerCaptcha, "Î", "")
        LeerCaptcha = Replace(LeerCaptcha, "?", "")
        LeerCaptcha = Replace(LeerCaptcha, "¿", "")
        LeerCaptcha = Replace(LeerCaptcha, "@", "")
        LeerCaptcha = Replace(LeerCaptcha, "*", "")
        LeerCaptcha = Replace(LeerCaptcha, "Ï", "")
        LeerCaptcha = Replace(LeerCaptcha, "¬", "")
        LeerCaptcha = Replace(LeerCaptcha, "ƒ", "")
        LeerCaptcha = Replace(LeerCaptcha, "!", "")
        LeerCaptcha = Replace(LeerCaptcha, "!", "")
        LeerCaptcha = Replace(LeerCaptcha, "‰", "")
        LeerCaptcha = Replace(LeerCaptcha, "'", "")
        LeerCaptcha = Replace(LeerCaptcha, "®", "")
        LeerCaptcha = Replace(LeerCaptcha, "‡", "")
        LeerCaptcha = Replace(LeerCaptcha, "", "")
        LeerCaptcha = Replace(LeerCaptcha, vbCrLf, "")
        LeerCaptcha = Replace(LeerCaptcha, vbCr, "")
        LeerCaptcha = Replace(LeerCaptcha, Chr(13), "")
        LeerCaptcha = Replace(LeerCaptcha, Chr(10), "")
    Wend
    Close #1
End Sub

Kod: 
Private Sub CommandButton1_Click()

On Error Resume Next

Set s1 = Worksheets("Şube_Listesi")

subeara = s1.Range("B:B").Find(ComboBox1.Value).Row

tc = s1.Cells(subeara, 13).Value
ekno = s1.Cells(subeara, 14).Value
sistemsifre = s1.Cells(subeara, 15).Value
isyerisifre = s1.Cells(subeara, 16).Value

Set s2 = Worksheets("SGK_Uygulama_Listesi")

uygulamaara = s2.Range("A:A").Find(ComboBox2.Value).Row
aurl = s2.Cells(uygulamaara, 2).Value
atc = s2.Cells(uygulamaara, 3).Value
aekno = s2.Cells(uygulamaara, 4).Value
asistemsifre = s2.Cells(uygulamaara, 5).Value
aisyerisifre = s2.Cells(uygulamaara, 6).Value
aisyeriguvenlik = s2.Cells(uygulamaara, 7).Value

Dim iim, status
Set iim = CreateObject("imacros")
status = iim.iimOpen("")

Dim macro
macro = "VERSION BUILD=10022823" + vbNewLine
macro = macro + "TAB T=1" + vbNewLine
macro = macro + "TAB CLOSEALLOTHERS" + vbNewLine
macro = macro + "URL GOTO=" & aurl & vbNewLine
Kill ThisWorkbook.Path & "\tessdata\luisrojas.txt"
macro = macro + "ONDOWNLOAD FOLDER=" & ThisWorkbook.Path & " FILE=mi_imagen.jpg" + vbNewLine
macro = macro + "TAG POS=1 TYPE=IMG FORM=NAME:formA ATTR=HREF:""https://uyg.sgk.gov.tr/SigortaliTescil/PG"" CONTENT=EVENT:SAVE_ELEMENT_SCREENSHOT" + vbNewLine
macro = macro + "WAIT SECONDS=5" + vbNewLine
macro = macro + "TAG POS=1 TYPE=INPUT:TEXT FORM=NAME:formA ATTR=NAME:" & atc & " Content = " & tc & vbNewLine
macro = macro + "TAG POS=1 TYPE=INPUT:TEXT FORM=NAME:formA ATTR=NAME:" & aekno & " Content = " & ekno & vbNewLine
macro = macro + "TAG POS=1 TYPE=INPUT:PASSWORD FORM=NAME:formA ATTR=NAME:" & asistemsifre & " Content = " & sistemsifre & vbNewLine
macro = macro + "TAG POS=1 TYPE=INPUT:PASSWORD FORM=NAME:formA ATTR=NAME:" & aisyerisifre & " Content = " & isyerisifre & vbNewLine
LeerArchivoTexto
macro = macro + "TAG POS=1 TYPE=INPUT:TEXT FORM=NAME:formA ATTR=NAME:" & aisyeriguvenlik & " Content = " & LeerCaptcha & vbNewLine

status = iim.iimPlayCode(macro)

End Sub
Genişletmek için tıkla ...


Uygulamayı indirebilirsiniz.
 
sayın zeynelhug,
ikinci mesajınızda sorun giderilmiş ver herkesin faydalanacağı bir dosya için paylaşım yapılmış gibi algıladım. bir açıklama yapılmamış.
ancak altın üye olduğunuz halde neden başka yükleme sitesine eklediniz. ayrıca dosya açılmıyor. chrome indirmeye izin vermiyor. bilgi verirseniz sevinirim. faydalanmak isterim.
teşekkürler...
 
spacebar' Alıntı:
sayın zeynelhug,
ikinci mesajınızda sorun giderilmiş ver herkesin faydalanacağı bir dosya için paylaşım yapılmış gibi algıladım. bir açıklama yapılmamış.
ancak altın üye olduğunuz halde neden başka yükleme sitesine eklediniz. ayrıca dosya açılmıyor. chrome indirmeye izin vermiyor. bilgi verirseniz sevinirim. faydalanmak isterim.
teşekkürler...
Genişletmek için tıkla ...
Sadece excel uygulamaları yükleniyor diye biliyorum. Klasör içinde farklı uygulamalarda olduğundan başka siteye yükledim. Konuyu yazarken altın üye değildim. Yeni sipariş geçmiştim. Sorun şu bir türlü çözemiyorum. Bir makro var dll dosyasını çalıştırıyor ve benim indirdiğim resimde ki karakterleri txt dosyasına ekliyor. İkinci bir makro replace komutlarıyla geçersiz karakter var ise değiştiriyor. iMacros sgk ekranı açıldıktan sonra ilk güvenlik kodunu indiriyor. Sonra güvenlik kodu hariç diğer alanları dolduruyor. En son olarak txt dosyası içinde yazan veriyi güvenlik kodu alanına yazıyor. Ama her seferinde daha önce ki güvenlik kodunu yazıyor.

Diğer dosyaları bu linkten indirebilirsiniz.

Not: Program iMacros üzerinden çalışmaktadır.

Farklı uzantılar olduğundan ek'e eklenmeyen uygulamaları yukarıda ki linkten indirebilirsiniz.
 

Ekli dosyalar

  • mi_imagen.png
    mi_imagen.png
    3.3 KB · Görüntüleme: 20
  • luisrojas.txt
    luisrojas.txt
    6 bayt · Görüntüleme: 39
  • deneme.xls
    deneme.xls
    401 KB · Görüntüleme: 69
Merhaba,
imacros ile bilgim yok ama, bulduğunuz dosyalar inanılmaz işe yaradı.
Kendi uygulamamda kullandım ve çok mutlu oldum. Siz her girdiğiniz linkten,
yeni resmi indirip indirmediğini kontrol edin ona göre bakarız.
Teşekkürler.
 
Teşekkür ederim bilgi paylaşınca güzel. Sizin uygulamanız ne üzerine?

Vba kodu ile mi kontrol edeyim? Yoksa kendim mi? Makro calisirken bakiyorum resmi indiriyor.
 
Merhabalar,

Uygulama Linki çalışmıyor uygulamayı bizdekullanabilirmiyiz.
 
zeynelhug' Alıntı:
Arkadaşlar,
Merhabalar,

Excel üzerinde imacros yazılımını kullanarak E-SGK uygulamalarına hızlı giriş yapabilmek için bir makro oluşturdum. Fakat bir sorun ile karşılaştım.

Ben iMacrosu kullanarak SGK uygulamalarına giriş yaparken istenen güvenlik kodunu otomatik olarak yazdırmak istiyorum. Bunun için bir uygulama buldum. Yalnız şöyle bir sorun var.

1- iMacros sgk sitesinden güvenlik kodunu belirlediğim klasöre kaydediyor.
2- Vba kodum ise o resmi .dll yardımı ile okuyor ve bir txt dosyasına kaydediyor.
3- Vba kodum daha sonra o txt dosyasında yazan veriyi istediğim yere işliyor.

Sorun şu ki; Bu süreçte daha önce indirmiş olduğu güvenlik kodunu istediğim yere yazıyor. Yeni indirilen güvenlik kodunu txt dosyasına yazmıyor.
Bunu nasıl çözebilirim.

Kod: 
Public LeerCaptcha As String

Sub GenerarTXT()
On Error Resume Next
Kill ThisWorkbook.Path & "\tessdata\luisrojas.txt"
      Shell ThisWorkbook.Path & "\modulo.dll " & ThisWorkbook.Path & "\mi_imagen.jpg " & ThisWorkbook.Path & "\tessdata\luisrojas", vbNormal
End Sub

Kod: 
Sub LeerArchivoTexto()

    Dim contador As Byte, Ruta$
voy:
    Ruta = Dir(ThisWorkbook.Path & "\tessdata\luisrojas.txt")
    If Ruta = "" And contador < 5 Then

        contador = contador + 1
        GoTo voy
    End If
   
    Open ThisWorkbook.Path & "\tessdata\luisrojas.txt" For Input As #1
    While Not EOF(1)
        Line Input #1, LeerCaptcha
        LeerCaptcha = UCase(LeerCaptcha)
        LeerCaptcha = Replace(LeerCaptcha, "     ", "")
        LeerCaptcha = Replace(LeerCaptcha, "    ", "")
       
        LeerCaptcha = Replace(LeerCaptcha, "   ", "")
        LeerCaptcha = Replace(LeerCaptcha, "  ", "")
        LeerCaptcha = Replace(LeerCaptcha, " ", "")
        LeerCaptcha = Replace(LeerCaptcha, Chr(13), "")
        LeerCaptcha = Replace(LeerCaptcha, Chr(34), "")
        LeerCaptcha = Replace(LeerCaptcha, "/", "")
        LeerCaptcha = Replace(LeerCaptcha, "(", "")
        LeerCaptcha = Replace(LeerCaptcha, ")", "")
        LeerCaptcha = Replace(LeerCaptcha, "[", "")
        LeerCaptcha = Replace(LeerCaptcha, "]", "")
        LeerCaptcha = Replace(LeerCaptcha, "|", "")
        LeerCaptcha = Replace(LeerCaptcha, ">", "")
        LeerCaptcha = Replace(LeerCaptcha, "<", "")
        LeerCaptcha = Replace(LeerCaptcha, ",", "")
        LeerCaptcha = Replace(LeerCaptcha, ".", "")
        LeerCaptcha = Replace(LeerCaptcha, ":", "")
        LeerCaptcha = Replace(LeerCaptcha, ";", "")
        LeerCaptcha = Replace(LeerCaptcha, "_", "")
        LeerCaptcha = Replace(LeerCaptcha, "-", "")
        LeerCaptcha = Replace(LeerCaptcha, "Ã", "")
        LeerCaptcha = Replace(LeerCaptcha, "Â", "")
        LeerCaptcha = Replace(LeerCaptcha, "Å", "")
        LeerCaptcha = Replace(LeerCaptcha, "€", "")
        LeerCaptcha = Replace(LeerCaptcha, "Î", "")
        LeerCaptcha = Replace(LeerCaptcha, "?", "")
        LeerCaptcha = Replace(LeerCaptcha, "¿", "")
        LeerCaptcha = Replace(LeerCaptcha, "@", "")
        LeerCaptcha = Replace(LeerCaptcha, "*", "")
        LeerCaptcha = Replace(LeerCaptcha, "Ï", "")
        LeerCaptcha = Replace(LeerCaptcha, "¬", "")
        LeerCaptcha = Replace(LeerCaptcha, "ƒ", "")
        LeerCaptcha = Replace(LeerCaptcha, "!", "")
        LeerCaptcha = Replace(LeerCaptcha, "!", "")
        LeerCaptcha = Replace(LeerCaptcha, "‰", "")
        LeerCaptcha = Replace(LeerCaptcha, "'", "")
        LeerCaptcha = Replace(LeerCaptcha, "®", "")
        LeerCaptcha = Replace(LeerCaptcha, "‡", "")
        LeerCaptcha = Replace(LeerCaptcha, "", "")
        LeerCaptcha = Replace(LeerCaptcha, vbCrLf, "")
        LeerCaptcha = Replace(LeerCaptcha, vbCr, "")
        LeerCaptcha = Replace(LeerCaptcha, Chr(13), "")
        LeerCaptcha = Replace(LeerCaptcha, Chr(10), "")
    Wend
    Close #1
End Sub

Kod: 
Private Sub CommandButton1_Click()

On Error Resume Next

Set s1 = Worksheets("Şube_Listesi")

subeara = s1.Range("B:B").Find(ComboBox1.Value).Row

tc = s1.Cells(subeara, 13).Value
ekno = s1.Cells(subeara, 14).Value
sistemsifre = s1.Cells(subeara, 15).Value
isyerisifre = s1.Cells(subeara, 16).Value

Set s2 = Worksheets("SGK_Uygulama_Listesi")

uygulamaara = s2.Range("A:A").Find(ComboBox2.Value).Row
aurl = s2.Cells(uygulamaara, 2).Value
atc = s2.Cells(uygulamaara, 3).Value
aekno = s2.Cells(uygulamaara, 4).Value
asistemsifre = s2.Cells(uygulamaara, 5).Value
aisyerisifre = s2.Cells(uygulamaara, 6).Value
aisyeriguvenlik = s2.Cells(uygulamaara, 7).Value

Dim iim, status
Set iim = CreateObject("imacros")
status = iim.iimOpen("")

Dim macro
macro = "VERSION BUILD=10022823" + vbNewLine
macro = macro + "TAB T=1" + vbNewLine
macro = macro + "TAB CLOSEALLOTHERS" + vbNewLine
macro = macro + "URL GOTO=" & aurl & vbNewLine
Kill ThisWorkbook.Path & "\tessdata\luisrojas.txt"
macro = macro + "ONDOWNLOAD FOLDER=" & ThisWorkbook.Path & " FILE=mi_imagen.jpg" + vbNewLine
macro = macro + "TAG POS=1 TYPE=IMG FORM=NAME:formA ATTR=HREF:""https://uyg.sgk.gov.tr/SigortaliTescil/PG"" CONTENT=EVENT:SAVE_ELEMENT_SCREENSHOT" + vbNewLine
macro = macro + "WAIT SECONDS=5" + vbNewLine
macro = macro + "TAG POS=1 TYPE=INPUT:TEXT FORM=NAME:formA ATTR=NAME:" & atc & " Content = " & tc & vbNewLine
macro = macro + "TAG POS=1 TYPE=INPUT:TEXT FORM=NAME:formA ATTR=NAME:" & aekno & " Content = " & ekno & vbNewLine
macro = macro + "TAG POS=1 TYPE=INPUT:PASSWORD FORM=NAME:formA ATTR=NAME:" & asistemsifre & " Content = " & sistemsifre & vbNewLine
macro = macro + "TAG POS=1 TYPE=INPUT:PASSWORD FORM=NAME:formA ATTR=NAME:" & aisyerisifre & " Content = " & isyerisifre & vbNewLine
LeerArchivoTexto
macro = macro + "TAG POS=1 TYPE=INPUT:TEXT FORM=NAME:formA ATTR=NAME:" & aisyeriguvenlik & " Content = " & LeerCaptcha & vbNewLine

status = iim.iimPlayCode(macro)

End Sub
Genişletmek için tıkla ...
dosya bulunamadı hatası veriyor. veya zipleyıp siteye yuklebilirseniz simdiden teşekkürler
 
merhaba sgk sistemlerine hızlı giriş için uygulama varmı
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst