• DİKKAT

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

web sayfasına veri gönderirken hata mesajı

B

bydogannn67

Altın Üye
Katılım
6 Ocak 2016
Mesajlar
226
Excel Vers. ve Dili
2010 türkçe
Merhabalar,

Excelden web'e veri gönderirken internet bağlantısı koptuğunda hata ekranı geliyo bunun yerıne mesaj kutusu gelsin istiyorum ama beceremiyorum yardımcı olabilirmisiniz

Kod: 
Private Sub CommandButton112_Click()
On Error GoTo hata
Dim URL As String
Dim IE As Object
On Error Resume Next
ThisWorkbook.Activate
If MsgBox(TextBox14.Text & "   " & " -  İLGİLİ KAYDA GİRİŞ YAPILSIN MI ? ", vbYesNo, "Dikkat") = vbNo Then Exit Sub

If TextBox15.Value = "" Or TextBox16.Value = "" Or TextBox17.Value = "" Or TextBox18.Value = "" Then
MsgBox "Lütfen listeden firma seçiniz...", vbCritical
Else

URL = "https://ebildirge.sgk.gov.tr/WPEB/amp/loginldap"

Set IE = CreateObject("https://uyg.sgk.gov.tr/IsvBildirimFormu/welcome.do")

With IE
.navigate URL
.Visible = 1
ShowWindow IE.hwnd, 3

Do Until IE.readyState = 4: DoEvents: Loop
Do While IE.Busy: DoEvents: Loop


IE.Document.all("kullaniciAdi").Value = TextBox15
IE.Document.all("isyeriKodu").Value = TextBox16
IE.Document.all("isyeriSifresi").Value = TextBox18
IE.Document.all("kaydet").Click
Do Until IE.readyState = 4: DoEvents: Loop
Do While IE.Busy: DoEvents: Loop

'ie.Quit: Set ie = Nothing
Else
hata:
MsgBox "İnternet bağlantısını kontrol edin", vbInformation
End With
End If
End Sub
 
İki kod aynı anda çalışmaz.

Kod: 
On Error GoTo hata
On Error Resume Next
 
Birde böyle deneyiniz.

Kod: 
[COLOR="red"]#If Win64 Then
Private Declare PtrSafe Function InternetCheckConnection Lib "wininet.dll" Alias "InternetCheckConnectionA" (ByVal lpszUrl As String, ByVal dwFlags As Long, ByVal dwReserved As Long) As Long
Private Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
#Else
Private Declare Function InternetCheckConnection Lib "wininet.dll" Alias "InternetCheckConnectionA" (ByVal lpszUrl As String, ByVal dwFlags As Long, ByVal dwReserved As Long) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
#End If[/COLOR]

Private Sub CommandButton112_Click()
On Error GoTo hata
Dim URL As String
Dim ie As Object
On Error Resume Next
ThisWorkbook.Activate
If MsgBox(TextBox14.Text & "   " & " -  İLGİLİ KAYDA GİRİŞ YAPILSIN MI ? ", vbYesNo, "Dikkat") = vbNo Then Exit Sub

If TextBox15.Value = "" Or TextBox16.Value = "" Or TextBox17.Value = "" Or TextBox18.Value = "" Then
MsgBox "Lütfen listeden firma seçiniz...", vbCritical
Else

[COLOR="SeaGreen"]URL = "https://ebildirge.sgk.gov.tr/WPEB/amp/loginldap"[/COLOR]

[COLOR="Red"]If (InternetCheckConnection(URL & "/", &H1, 0&) = 0) Then MsgBox "internet bağlantısı yok": Exit Sub[/COLOR]



Set ie = CreateObject("https://uyg.sgk.gov.tr/IsvBildirimFormu/welcome.do")

With ie
.navigate URL
.Visible = 1
ShowWindow ie.hWnd, 3


Do Until ie.readyState = 4: DoEvents: Loop
Do While ie.Busy: DoEvents: Loop


ie.Document.all("kullaniciAdi").Value = TextBox15
ie.Document.all("isyeriKodu").Value = TextBox16
ie.Document.all("isyeriSifresi").Value = TextBox18
ie.Document.all("kaydet").Click
Do Until ie.readyState = 4: DoEvents: Loop
Do While ie.Busy: DoEvents: Loop

'ie.Quit: Set ie = Nothing
Else
hata:
MsgBox "İnternet bağlantısını kontrol edin", vbInformation
End With
End If
End Sub
 
Hocam yardımlarınız için teşekkurler fakat internet varsa bile internet yok diye bilgi veriyo dosyayı ekledım ınceleyebilirmisiniz
 

Ekli dosyalar

Hocam merhabalar,

yardımınızla kodları uyarlamaya çalıştım internet yokken beni uyardı benim istediğimde burdu fakat bu seferde verileri ilgili alanlara gönderemedim

Benim istediğim butona tıkladığımda verileri ilgili alanlara göndersin eğer sgk sayfası açılamadığında internet açılmadığında bana uyarı versin

Kod: 
#If Win64 Then
Private Declare PtrSafe Function InternetCheckConnection Lib "wininet.dll" Alias "InternetCheckConnectionA" (ByVal lpszUrl As String, ByVal dwFlags As Long, ByVal dwReserved As Long) As Long
Private Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
#Else
Private Declare Function InternetCheckConnection Lib "wininet.dll" Alias "InternetCheckConnectionA" (ByVal lpszUrl As String, ByVal dwFlags As Long, ByVal dwReserved As Long) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
#End If
Sub ssk()
Dim URL As String
Dim IE As Object

If InternetCheckConnection("https://uyg.sgk.gov.tr/", FLAG_ICC_FORCE_CONNECTION, 0&) = 0 Then
        MsgBox "İnternet bağlantısı bulunamadı", vbInformation
        Exit Sub
    Else
URL = "https://uyg.sgk.gov.tr/SigortaliTescil/amp/loginldap"
Set IE = CreateObject("InternetExplorer.Application")
With IE
.navigate URL
.Visible = 1
ShowWindow IE.hWnd, 3

Do Until IE.readyState = 4: DoEvents: Loop
Do While IE.Busy: DoEvents: Loop
IE.Document.all("j_username").Value = TextBox15
IE.Document.all("isyeri_kod").Value = TextBox16
IE.Document.all("j_password").Value = TextBox17
IE.Document.all("isyeri_sifre").Value = TextBox18

Do Until IE.readyState = 4: DoEvents: Loop
Do While IE.Busy: DoEvents: Loop
'ie.Quit: Set ie = Nothing
End With
    End If
End Sub
 
Dosyayı ekledım ıncelermısınız

sorun yıne devam ediyo
 

Ekli dosyalar

4. nolu mesajdaki kodu düzelttim.

kodu bu şekilde kullanın

Kod: 
Sub ssk()
Dim URL As String
Dim IE As Object
[COLOR="Red"]URL = "https://uyg.sgk.gov.tr/SigortaliTescil/amp/loginldap"[/COLOR]
[COLOR="SeaGreen"]If (InternetCheckConnection(URL & "/", &H1, 0&) = 0) Then MsgBox "internet bağlantısı yok": Exit Sub[/COLOR]

Set IE = CreateObject("InternetExplorer.Application")
With IE
.navigate URL
.Visible = 1
ShowWindow IE.hWnd, 3

Do Until IE.readyState = 4: DoEvents: Loop
Do While IE.Busy: DoEvents: Loop
IE.Document.all("j_username").Value = TextBox15
IE.Document.all("isyeri_kod").Value = TextBox16
IE.Document.all("j_password").Value = TextBox17
IE.Document.all("isyeri_sifre").Value = TextBox18

Do Until IE.readyState = 4: DoEvents: Loop
Do While IE.Busy: DoEvents: Loop
'ie.Quit: Set ie = Nothing
End With
End Sub
 
hocam malesef yıne verileri ilgili alanlara gönderemiyorum

siz benim dosyada deniyebildiniz mi

PkM485.png
 
Merhabalar,

Kodlar arası çakışma olmuş sorunu buldum ilginiz için teşekkür ederim :)
 
bydogannn67' Alıntı:
Merhabalar,
Excelden web'e veri gönderirken internet bağlantısı koptuğunda hata ekranı geliyo bunun yerıne mesaj kutusu gelsin istiyorum ama beceremiyorum yardımcı olabilirmisiniz
Genişletmek için tıkla ...

Birinci mesajınızdaki sorunuza cevaben kodları yazmıştım yoksa verilerin yanlış yerlere gittiğini ben bilemem.
 
Hocam makroyu kullanmadan açık olan İE sayfalarını kapatıp bu makroyla yenı sayfa açma şansımız varmı

ekranda açık olan sgk sayfası varsa butona tıkladığımızda hata veriyo
 
bydogannn67' Alıntı:
Hocam makroyu kullanmadan açık olan İE sayfalarını kapatıp bu makroyla yenı sayfa açma şansımız varmı

ekranda açık olan sgk sayfası varsa butona tıkladığımızda hata veriyo
Genişletmek için tıkla ...

kod:

Kod: 
Sub acık_html_sayfalarını_kapat2()
For Each IE In CreateObject("Shell.Application").Windows
If TypeName(IE.Document) = "HTMLDocument" Then
IE.Quit
End If
Next
End Sub

kod2:

Kod: 
Sub acık_html_sayfalarını_kapat1()
aranan = "https://ebildirge.sgk.gov.tr/WPEB/amp/loginldap"
For Each IE In CreateObject("Shell.Application").Windows
If TypeName(IE.Document) = "HTMLDocument" Then
If IE.LocationURL = aranan Then
IE.Quit
End If
End If
Next
End Sub
 
Halit hocam merhabalar,

yardımınıza ihtiyacım var resimdeki alana otomatık tıklatmak istiyorum

alanlar isimli olunca öge denetle ile kendim yapabiliyorum ama iş url olunca nası yapıcam bilemedim

<A href="/vizite/tarihGiris.do">Tarihe Göre Rapor Arama</A>

Pknkz7.png
 
Öncelikle bu tür sitelerle ilgili ben artık uğraşmıyorum çünkü güvenlik resmi uyguluyor ve bunun çözümü şimdilik yok herhalde birde siz kullanıcı adı ile giriş yapmışsınız ben bunu bilemem size iyi çalışmalar
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst