• DİKKAT

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

Exel den web sayfasına veri aktarma

kodun tamamı bu olacak
calistir ve durdur makrolarını kullanacaksınız.


Kod:
Public saat As Date
Public Const devamet = "calistir"


Sub calistir()

Dim ie As Object

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

saat = Now + TimeValue("00:00:10")


Application.OnTime EarliestTime:=saat, Procedure:=devamet, Schedule:=True
End Sub
 
Sub durdur()
On Error Resume Next
Application.OnTime EarliestTime:=saat, Procedure:=devamet, Schedule:=False
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
 
internet explorer de başka sayfa açmıyacaksınız bu kudu bir deneyiniz. modülün içinde sadece bu kodlar olsun

Kod:
Public saat As Date
Public Const devamet = "calistir"
Dim IE As Object
Dim say

Sub calistir()

say = say + 1
If say = 1 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

saat = Now + TimeValue("00:00:10")

Application.OnTime EarliestTime:=saat, Procedure:=devamet, Schedule:=True
End Sub
Sub durdur()
On Error Resume Next
Application.OnTime EarliestTime:=saat, Procedure:=devamet, Schedule:=False
say = 0
End Sub
 
S.A. Excel ortamında hazırladığım formu mebbis.meb.gov tr ortamına aktarabilirmiyim.Mebbistedi formların satır sayısı exceldeki ile birebir aynı
 
Geri
Üst