Exel den web sayfasına veri aktarma

[mustafaemre]

Merhaba

exelde ufak bir birşey yaptım.
alt alta veriler içeren 45 satır var. bu verileri bir buton yardımı ile testious.com sitesindeki

<textarea id="clinesTextArea" class="clinesTextArea" placeholder="Insert clines or nlines here..." rows="10"></textarea>

kutucuğa veriyi aktarıp

<input class="Button" id="processBtn" onclick="process();" type="button" value="Process">

process butonuna basma işlemini yaptırabilirmiyiz.

bu konuda yardımcı olabilirmisiniz.

 

[Asri]

Kontrol ediniz.
VBA tool reference de Microsoft internet contro seçili olmalı

http://s5.dosya.tc/server5/8zi5ls/testious.com_web_.zip.html

Dim islem, URL As String
Dim ie As Object
Dim objCollection As Object

Sub bekle()
    With ie
        Do Until .readyState = 4: DoEvents: Loop
        Do While .Busy: DoEvents: Loop
    End With
End Sub

Sub url_ac()
    
    If InStr(GetIEWindows, "testious.com") <= 0 Then
        URL = "www.testious.com"
        Set ie = CreateObject("InternetExplorer.Application")
        With ie
          .Navigate URL
          .Visible = 1
        End With
    End If
    Call bekle
    
    sonsatir = Cells(Rows.Count, "A").End(3).Row + 1
    For j = 1 To sonsatir
       veri = veri & Cells(j, "A").Value & Chr(13)
    Next j
  
    Set objCollection = ie.Document.getElementsByTagName("textarea")
    i = 0
    Do While i < objCollection.Length
      If objCollection(i).ID = "clinesTextArea" Then
         objCollection(i).Value = veri
         Exit Do
      End If
      i = i + 1
    Loop
End Sub


Function GetIEWindows() As String
    Dim SWs As SHDocVw.ShellWindows, vIE As SHDocVw.InternetExplorer
    Set SWs = New SHDocVw.ShellWindows
    For Each vIE In SWs
        If Left(vIE.LocationURL, 4) = "http" Then 'avoid explorer windows/etc this way
            GetIEWindows = vIE.LocationURL
            Exit Function
        End If
    Next
    GetIEWindows = ""
    Set SWs = Nothing
    Set vIE = Nothing
End Function

 

[mustafaemre]

usta teşekkür ederim. kodu excel e ekledim.
aktaracağım veri h1 den h46 kadar olan satırlarda. butana kodu ekdim çalıştı ama sadece H1 deki veriyi aktarıyor. birde internet exploreri kapatmayınca exceldeki butonlar çalışmıyor. internet exploreri kapatıncada bu uyarıyı veriyor. birde internet explorer yerine chrome çalıştırılabilirmi?

 

[Asri]

usta teşekkür ederim. kodu excel e ekledim.
aktaracağım veri h1 den h46 kadar olan satırlarda. butana kodu ekdim çalıştı ama sadece H1 deki veriyi aktarıyor. birde internet exploreri kapatmayınca exceldeki butonlar çalışmıyor. internet exploreri kapatıncada bu uyarıyı veriyor. birde internet explorer yerine chrome çalıştırılabilirmi?

Sayfada resim doğrulama olduğu için bu işlemi otomatik (en azından bu şekilde) yapamazsınız.

"Kodlar A1 den başlayarak kutuya yazıları yazar.

Sizden doğrulama kodunu seçip process e basmanızı bekler.

Daha sonra A2 deki veriyi yazar ve işlemler bu şekilde son veri yazılana kadar devam eder."

Sanırım yazdığım açıklamaya dikkat etmediniz.

 

[mustafaemre]

Sayfada resim doğrulama olduğu için bu işlemi otomatik (en azından bu şekilde) yapamazsınız.



Sanırım yazdığım açıklamaya dikkat etmediniz.

usta resim doğrulama yüzünden oto olmuyor onu biliyorum. yani bu 46 satırı aynı anda siteye aktarabilirmiyiz tek tek değilde. dosyayı size pm olarak göndermiştim. bakabildiyseniz. her taramadan sonra artır butonuna basıp kopyalıyordum

 

[Asri]

usta resim doğrulama yüzünden oto olmuyor onu biliyorum. yani bu 46 satırı aynı anda siteye aktarabilirmiyiz tek tek değilde.

Sanırım ben yanlış yorumladım.
Ben her bir satır ayrı sorgulanacak gibi düşündüm.

 

[Asri]

Kod güncellendi.

 

[mustafaemre]

teşekkürler usta oldu. ufak bir sorun var
butona her basışta yeni bir explorer açıyor. onun yerine açık explorerden devam etmesi mümkünmü?

*************

Dim chromePath As String
chromePath = """C:\Program Files\Google\Chrome\Application\chrome.exe"""
Shell (chromePath & " -url http:www.testious.com")

usta bu kodu entegre edebilirmiyiz. sormamdaki sebep vpn kullanıyorum. testiousu çok kullanılıyorsa ban atıyor bir gün. ama vpn kullanınca ban atmıyor.

 

[Asri]

teşekkürler usta oldu. ufak bir sorun var
butona her basışta yeni bir explorer açıyor. onun yerine açık explorerden devam etmesi mümkünmü?

*************

Dim chromePath As String
chromePath = """C:\Program Files\Google\Chrome\Application\chrome.exe"""
Shell (chromePath & " -url http:www.testious.com")

usta bu kodu entegre edebilirmiyiz. sormamdaki sebep vpn kullanıyorum. testiousu çok kullanılıyorsa ban atıyor bir gün. ama vpn kullanınca ban atmıyor.

Bu kod ile sadece chrome u açabilirsiniz. İçine birşey yazamazsınız.

Kesin olarak kullanamazsınız diyemem, chrome kullanmaya çalışmak için harcanacak zamana deymez

"excel vba selenium chrome" olarak araştırınız.

 

[mustafaemre]

Bu kod ile sadece chrome u açabilirsiniz. İçine birşey yazamazsınız.

Kesin olarak kullanamazsınız diyemem, chrome kullanmaya çalışmak için harcanacak zamana deymez

"excel vba selenium chrome" olarak araştırınız.

teşekkürler ustam. tavsiyenize uyup ie ile devam ederim. ustam butona her basışta yeni ie açmak yerine açılmış ie ile devam etmek mümkün mü?

 

[Asri]

teşekkürler ustam. tavsiyenize uyup ie ile devam ederim. ustam butona her basışta yeni ie açmak yerine açılmış ie ile devam etmek mümkün mü?

Kod ve dosya güncellendi.

Kontrol ediniz.

 

[mustafaemre]

teşekkürler usta. sizin dosyada sıkıntı yok. kodu benim dosyala aldığımda resimde belirttiğim yerde hata veriyor

Formülleri sizin dosyaya aktardığımda ise bu hatayı veriyor

 

[Asri]

teşekkürler usta. sizin dosyada sıkıntı yok. kodu benim dosyala aldığımda resimde belirttiğim yerde hata veriyor




Formülleri sizin dosyaya aktardığımda ise bu hatayı veriyor

"VBA tools reference de Microsoft internet control seçili olmalı " mesajımda bu açıklamaya dikkat etmemişsiniz sanırım.

Dosyanız .xslm olarak kaydedilmiş olmalı ve excel vba bölümünde bu işlem yapılmış olmalı.

 

[mustafaemre]

ustam gözümden kaçmış kusura bakma. çok teşekkürler çalıştı sonunda.

 

[mustafaemre]

merhaba ustam.
ustam başka bir site buldum. veriyi yeni siteye aktarıyorum. lakin buradaki kontrol et butonuna basamıyorum.

<button type="button" class="uiButton uiColored btnCheck">Kontrol et</button>
http://hulk.hol.es/private-ccam/cam.php

Dim islem, URL As String
Dim ie As Object
Dim objCollection As Object

Sub bekle()
    With ie
        Do Until .ReadyState = 4: DoEvents: Loop
        Do While .Busy: DoEvents: Loop
    End With
End Sub

Sub url_ac()
    
    If InStr(GetIEWindows, "hulk.hol.es") <= 0 Then
        URL = "http://hulk.hol.es/private-ccam/cam.php"
        Set ie = CreateObject("InternetExplorer.Application")
        With ie
          .Navigate URL
          .Visible = 1
        End With
    End If
    Call bekle
    
    sonsatir = Cells(Rows.Count, "H").End(3).Row + 1
    For j = 1 To sonsatir
       veri = veri & Cells(j, "H").Value & Chr(13)
    Next j
 
    Set objCollection = ie.Document.getelementsbytagname("textarea")
    i = 0
    Do While i < objCollection.Length
      If objCollection(i).Name = "lines" Then
         objCollection(i).Value = veri
         Exit Do
      End If
      i = i + 1
    Loop
End Sub

Function GetIEWindows() As String
    Dim SWs As SHDocVw.ShellWindows, vIE As SHDocVw.InternetExplorer
    Set SWs = New SHDocVw.ShellWindows
    For Each vIE In SWs
        If Left(vIE.LocationURL, 4) = "http" Then 'avoid explorer windows/etc this way
            GetIEWindows = vIE.LocationURL
            Exit Function
        End If
    Next
    GetIEWindows = ""
    Set SWs = Nothing
    Set vIE = Nothing
End Function

birde makrom var

' Makro2 Makro
'
'           
    Range("B1").Select
Range("B1") = Range("B1") + 1
    Range("B1").Select

acaba tek butonla
15sn aralıkla veriyi siteye gönderecek butona basacak ve makco2 yi çalıştıracak bir döngü yapılabilirmi? bu konuda yardımcı olabilirmisiniz.

 

[halit3]

kontrol et buttonu için kod

IE.document.getElementsByTagName("textarea").Item(0).Value = "veriler buraya yazılacak"
Application.Wait (Now + TimeValue("00:00:01"))

IE.document.getElementsByTagName("button").Item(1).Click

 

[mustafaemre]

ustam çok teşekkür ederim işime yaradı.

 

[mustafaemre]

ustam döngüyü çalıştırdım her 10 sn de kendini tekrarlıyor. lakin başka bir butona bu döngüyü durdurmak için kod (nette bulduğum kodları denedim.) yazdım ama çalışmadı. acaba yardımcı olabilirmisin

Dim islem, URL As String
Dim ie As Object
Dim objCollection As Object

Sub bekle()
    With ie
        Do Until .ReadyState = 4: DoEvents: Loop
        Do While .Busy: DoEvents: Loop
    End With
End Sub

Sub url_ac()
    
    If InStr(GetIEWindows, "hulk.hol.es") <= 0 Then
        URL = "http://hulk.hol.es/private-ccam/cam.php"
        Set ie = CreateObject("InternetExplorer.Application")
        With ie
          .Navigate URL
          .Visible = 1
        End With
    End If
    Call bekle
    
    sonsatir = Cells(Rows.Count, "H").End(3).Row + 1
    For j = 1 To sonsatir
       veri = veri & Cells(j, "H").Value & Chr(13)
    Next j
 
    Set objCollection = ie.Document.getElementsByTagName("textarea")
    i = 0
    Do While i < objCollection.Length
      If objCollection(i).Name = "lines" Then
         objCollection(i).Value = veri
         Exit Do
      End If
      i = i + 1
    Loop
ie.Document.getElementsByTagName("button").Item(1).Click

    Range("B1").Select
Range("B1") = Range("B1") + 1
    Range("B1").Select

Application.OnTime Now + TimeValue("00:00:10"), "url_ac"
End Sub

 

[halit3]

kod:

Dim islem, URL As String
Dim ie As Object
Dim objCollection As Object

Dim NextTick As Date

Sub calistir()
url_ac
zaman = CDate(Format(Now, "hh:nn:ss"))
NextTick = Now + TimeValue(zaman)
Application.OnTime NextTick, "calistir", schedule:=True
End Sub

Sub Durdur()
On Error Resume Next
Application.OnTime Earliesttime:=NextTick, procedure:="calistir", schedule:=False
End Sub

Sub url_ac()

If InStr(GetIEWindows, "hulk.hol.es") <= 0 Then
URL = "http://hulk.hol.es/private-ccam/cam.php"
Set ie = CreateObject("InternetExplorer.Application")
With ie
.Navigate URL
.Visible = 1
End With
End If

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

sonsatir = Cells(Rows.Count, "H").End(3).Row + 1
For j = 1 To sonsatir
veri = veri & Cells(j, "H").Value & Chr(13)
Next j

ie.document.getElementsByTagName("textarea").Item(0).Value = veri
Application.Wait (Now + TimeValue("00:00:01"))

ie.document.getElementsByTagName("button").Item(1).Click
Cells(1, 2).Value = Cells(1, 2).Value + 1

Application.OnTime Now + TimeValue("00:00:10"), "url_ac"
End Sub

 

[mustafaemre]

ustam kodu aynen yapıştırdım lakin başlayınca durdurmuyor. iki buton yaptım biri başla diğeri durdur. butonlara çalıştır ve durdur makrolarını atadım.

modül içindeki tüm kodları yazıyorum

Dim islem, URL As String
Dim ie As Object
Dim objCollection As Object

Dim NextTick As Date

Sub calistir()
url_ac
zaman = CDate(Format(Now, "hh:nn:ss"))
NextTick = Now + TimeValue(zaman)
Application.OnTime NextTick, "calistir", schedule:=True
End Sub

Sub Durdur()
On Error Resume Next
Application.OnTime Earliesttime:=NextTick, procedure:="calistir", schedule:=False
End Sub

Sub url_ac()

If InStr(GetIEWindows, "hulk.hol.es") <= 0 Then
URL = "http://hulk.hol.es/private-ccam/cam.php"
Set ie = CreateObject("InternetExplorer.Application")
With ie
.Navigate URL
.Visible = 1
End With
End If

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

sonsatir = Cells(Rows.Count, "H").End(3).Row + 1
For j = 1 To sonsatir
veri = veri & Cells(j, "H").Value & Chr(13)
Next j

ie.Document.getElementsByTagName("textarea").Item(0).Value = veri
Application.Wait (Now + TimeValue("00:00:01"))

ie.Document.getElementsByTagName("button").Item(1).Click
Cells(1, 2).Value = Cells(1, 2).Value + 1

Application.OnTime Now + TimeValue("00:00:10"), "url_ac"
End Sub

Function GetIEWindows() As String
Dim SWs As SHDocVw.ShellWindows, vIE As SHDocVw.InternetExplorer
Set SWs = New SHDocVw.ShellWindows
For Each vIE In SWs
If Left(vIE.LocationURL, 4) = "http" Then 'avoid explorer windows/etc this way
GetIEWindows = vIE.LocationURL
Exit Function
End If
Next
GetIEWindows = ""
Set SWs = Nothing
Set vIE = Nothing
End Function