Exel den web sayfasına veri aktarma

mustafaemre · 29 Ekim 2017

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

Kod:

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

kutucuğa veriyi aktarıp

Kod:

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

process butonuna basma işlemini yaptırabilirmiyiz.

bu konuda yardımcı olabilirmisiniz.

Asri · 29 Ekim 2017

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

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

Kod:

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 · 29 Ekim 2017

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 · 30 Ekim 2017

mustafaemre' Alıntı:
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 · 1 Kasım 2017

asri' Alıntı:
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 · 1 Kasım 2017

mustafaemre' Alıntı:
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 · 1 Kasım 2017

Kod güncellendi.

mustafaemre · 1 Kasım 2017

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 · 2 Kasım 2017

mustafaemre' Alıntı:
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 · 2 Kasım 2017

asri' Alıntı:
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 · 2 Kasım 2017

mustafaemre' Alıntı:
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 · 3 Kasım 2017

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 · 3 Kasım 2017

mustafaemre' Alıntı:
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 · 3 Kasım 2017

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

mustafaemre · 2 Aralık 2018

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

Kod:

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

Kod:

' 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 · 2 Aralık 2018

kontrol et buttonu için kod

Rich (BB code):

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 · 2 Aralık 2018

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

mustafaemre · 3 Aralık 2018

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

Kod:

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 · 3 Aralık 2018

kod:

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 · 3 Aralık 2018

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

Exel den web sayfasına veri aktarma

mustafaemre

Asri

mustafaemre

Asri

mustafaemre

Asri

Asri

mustafaemre

Asri

mustafaemre

Asri

mustafaemre

Asri

mustafaemre

mustafaemre

halit3

Uzman

mustafaemre

mustafaemre

halit3

Uzman

mustafaemre