Skip to main content

AccessTr.neT


Webbrowser Elementlerin İd'erini Bulmak

Webbrowser Elementlerin İd'erini Bulmak

#4
mesaj 2'yi güncelledim.
zip olarak da ekledim, farklı winrar sürümüyle denediniz mi?
form1'e eklenen kodlar:

#If VBA7 And Win64 Then '64 bit için
Private Declare PtrSafe Function URLDownloadToFileA Lib "urlmon" (ByVal pCaller As Long, _
ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, _
ByVal lpfnCB As Long) As Long
 
#Else '32 bit için
Private Declare  Function URLDownloadToFileA Lib "urlmon" (ByVal pCaller As Long, _
ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, _
ByVal lpfnCB As Long) As Long

#End If
buton3'ün kodu
Private Sub Komut3_Click()
Dim TextFile As Integer
Dim FilePath As String
Dim FileContent As String
Dim txtAranan As String
Dim xYer As LongLong
Dim x As Integer
'File Path of Text File
On Error Resume Next
FilePath = Application.CurrentProject.Path & "\template.txt"
If Len(Dir$(FilePath)) > 0 Then Kill FilePath
'On Error GoTo 0
Open FilePath For Output As #1
'Print #1, "Boş"
Close acSaveYes
DownloadFile "file:///" & Application.CurrentProject.Path & "/dersnotu.html", FilePath ' "D:\Google.txt"

txtAranan = "dgListem_txtY1_"
'Determine the next file number available for use by the FileOpen function
  TextFile = FreeFile

'Open the text file in a Read State
  Open FilePath For Input As TextFile

'Store file content inside a variable
  FileContent = Input(LOF(TextFile), TextFile)

'Clost Text File
  Close TextFile
  Liste1.RowSource = ""
'Find
'Deneme____________________________
x = 0
Do
xYer = InStr(1, FileContent, txtAranan & x)
'If xYer > 0 Then Debug.Print txtAranan & x
If xYer > 0 Then Liste1.AddItem txtAranan & x
x = x + 1
Loop While xYer > 0
'Deneme____________________________BİTTİ

'Determine the next file number available for use by the FileOpen function
  TextFile = FreeFile

'Open the text file in a Write State
  Open FilePath For Output As TextFile
 
'Write New Text data to file
  Print #TextFile, FileContent

'Close Text File
  Close TextFile
FilePath = Application.CurrentProject.Path & "\template.txt"
If Len(Dir$(FilePath)) > 0 Then Kill FilePath
'  MsgBox ("Bitti")
End Sub
eklenen fonksiyon:
Private Function DownloadFile(URL As String, LocalFilename As String) As Boolean
'Thanks Mentalis
Dim lngRetVal As Long
lngRetVal = URLDownloadToFileA(0, URL, LocalFilename, 0, 0)
If lngRetVal = 0 Then DownloadFile = True
End Function
Cevapla

Bir hesap oluşturun veya yorum yapmak için giriş yapın

Yorum yapmak için üye olmanız gerekiyor

ya da

Bu Konudaki Yorumlar
Cvp: Webbrowser Elementlerin İd'erini Bulmak - Yazar: berduş - 28/06/2019, 16:22