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
#1
site.rar
(Dosya Boyutu: 273,17 KB | İndirme Sayısı: 4)
