Chào anh chị em trong diễn đàn!
Tôi có một file txt như file đính kèm.Nội dung trong đó có chứa các đường link cần lấy nằm trong các thẻ của html.Các anh chị cho hỏi làm sao để dùng Vba lấy các đường link đó ra excel ?
Xin chân thành cảm ơn!
Chào anh chị em trong diễn đàn!
Tôi có một file txt như file đính kèm.Nội dung trong đó có chứa các đường link cần lấy nằm trong các thẻ của html.Các anh chị cho hỏi làm sao để dùng Vba lấy các đường link đó ra excel ?
Xin chân thành cảm ơn!
Option Explicit
Sub NTKTNN()
Dim i As Long
Dim FileNum As Integer
Dim DataLine As String
FileNum = FreeFile()
Open "C:\Users\plan14\Downloads\sample.txt" For Input As #FileNum
While Not EOF(FileNum)
Line Input #FileNum, DataLine
If InStr(DataLine, "'https://") > 0 Then
i = i + 1
Cells(i, 1) = DataLine
End If
Wend
Close #FileNum
End Sub
Sub Test()
Dim s$, i&, t$, p1%, p2%
Open "C:\sample.txt" For Input As #1
i = 1
Do Until EOF(1)
Line Input #1, s
If s Like "*http*" Then
p1 = InStr(s, "http")
p2 = InStr(p1 + 8, s, "/")
t = Mid(s, p1, p2 - p1)
Sheet1.Range("A" & i) = t
i = i + 1
End If
Loop
Close #1
End Sub
Chào anh chị em trong diễn đàn!
Tôi có một file txt như file đính kèm.Nội dung trong đó có chứa các đường link cần lấy nằm trong các thẻ của html.Các anh chị cho hỏi làm sao để dùng Vba lấy các đường link đó ra excel ?
Xin chân thành cảm ơn!
Tổng quát nhất theo tôi nên sử dụng Regular Expression,
Có thể tham khảo :
Mã:
Sub GetWebLink()
Dim strSource As String, fso As New FileSystemObject, Result, item
Dim oMatch As IMatchCollection2
strSource = fso.OpenTextFile(Application.GetOpenFilename(), ForReading).ReadAll
With New RegExp
.Global = True
.IgnoreCase = True
.Pattern = "https?://(www\.)?[a-z0-9\-]{3,}(\.[a-z]{2,4}){1,2}"
If .Test(strSource) Then
Set oMatch = .Execute(strSource)
For Each item In oMatch
Result = Result & item & vbCrLf
Next
MsgBox Result
End If
End With
End Sub
Lưu ý để sử dụng được code trên bạn phải tích chọn tham chiếu 2 đối tượng được hight light như ảnh bên dưới
p1 là vị trí tìm được của "http", có 4 ký tự.
p1+8 là vị trí bắt đầu tìm của hàm InStr, do sau "http có dấu "/", ví dụ: "https://", chiều dài chuỗi này là 8, nên tôi cộng thêm để tìm vị trí dấu "/" sau chuỗi "https:// ..."
+8 không quan trọng bằng với việc mình đi đọc hướng dẫn hàm Instr() ấy.
Gõ vào Google: instr in VBA.
Rồi mình sẽ hiểu tại sao nên viết là + len("http") thay vì +8
Nếu là chuỗi html thì đường dẫn nó nằm trong cái tag a, attribute href chứ.
Bình thường thì chỉ cần parse Dom Document. Có thể dùng XML Object hay HTML Object đều được.
Nếu là chuỗi html thì đường dẫn nó nằm trong cái tag a, attribute href chứ.
Bình thường thì chỉ cần parse Dom Document. Có thể dùng XML Object hay HTML Object đều được.
Sub GetWebLink()
Dim i As Long, s As String
Open "C:\sample.txt" For Input As #1
Do Until EOF(1)
Line Input #1, s
If s Like "*http*" Then
With CreateObject("VBScript.RegExp")
.Global = True
.IgnoreCase = True
.Pattern = "https?://(www\.)?[a-z0-9\-]{3,}(\.[a-z]{2,4}){1,2}"
If .Test(s) Then
i = i + 1
Sheet1.Range("A" & i) = .Execute(s)(0)
End If
End With
End If
Loop
Close #1
End Sub
Sub GetWebLink()
Dim strSource As String, fso As Object, RegExp As Object, Result, item, oMatch
Set fso = CreateObject("Scripting.FileSystemObject")
Set RegExp = CreateObject("VBScript.Regexp")
strSource = fso.OpenTextFile(Application.GetOpenFilename(), 1).ReadAll
With RegExp
.Global = True
.IgnoreCase = True
.Pattern = "https?://(www\.)?[a-z0-9\-]{3,}(\.[a-z]{2,4}){1,2}"
If .Test(strSource) Then
Set oMatch = .Execute(strSource)
For Each item In oMatch
Result = Result & item & vbCrLf
Next
MsgBox Result
End If
End With
End Sub
Sub GetWebLink()
Dim strSource As String, fso As Object, RegExp As Object, Result, item, oMatch
Set fso = CreateObject("Scripting.FileSystemObject")
Set RegExp = CreateObject("VBScript.Regexp")
strSource = fso.OpenTextFile(Application.GetOpenFilename(), 1).ReadAll
With RegExp
.Global = True
.IgnoreCase = True
.Pattern = "https?://(www\.)?[a-z0-9\-]{3,}(\.[a-z]{2,4}){1,2}"
If .Test(strSource) Then
Set oMatch = .Execute(strSource)
For Each item In oMatch
Result = Result & item & vbCrLf
Next
MsgBox Result
End If
End With
End Sub
Giả sử sample.txt và tập tin Excel nằm cùng thư mục. Nếu khác thì sửa filename. Không phải chọn gì trong Tools cả.
Mã:
Sub Test()
Dim count As Long, filename As String, text As String
Dim htmlDocument As Object, fso As Object
Dim el As Object
Set htmlDocument = CreateObject("HtmlFile")
Set fso = CreateObject("Scripting.FileSystemObject")
filename = ThisWorkbook.Path & "\sample.txt"
htmlDocument.body.innerHTML = "<html><head>" & fso.OpenTextFile(filename).ReadAll
For Each el In htmlDocument.getElementsByTagName("a")
count = count + 1
Sheet1.Range("A" & count).Value = el.href
Next el
Set htmlDocument = Nothing
Set fso = Nothing
End Sub
Nếu tôi hiểu link trong "Lấy đường link ..." là link thực sự thì chưa có code nào trong chủ đề này làm chuẩn 100%. Hoặc làm vừa thiếu vừa thừa, hoặc cho kết quả sai.
Với tôi thì link là cái mắt tôi nhìn thấy, tay tôi có thể đưa chuột tới nó, và khi click thì tôi sẽ được chuyển sang chỗ khác. Đấy mới là LINK. Vì thế những vd. 'https://www.332343546855.com:9900/' trong thẻ script đâu có là link? Có nhìn thấy, có thể click vào https://www.332343546855.com:9900/ không?
Giả sử sample.txt và tập tin Excel nằm cùng thư mục. Nếu khác thì sửa filename. Không phải chọn gì trong Tools cả.
Mã:
Sub Test()
Dim count As Long, filename As String, text As String
Dim htmlDocument As Object, fso As Object
Dim el As Object
Set htmlDocument = CreateObject("HtmlFile")
Set fso = CreateObject("Scripting.FileSystemObject")
filename = ThisWorkbook.Path & "\sample.txt"
htmlDocument.body.innerHTML = "<html><head>" & fso.OpenTextFile(filename).ReadAll
For Each el In htmlDocument.getElementsByTagName("a")
count = count + 1
Sheet1.Range("A" & count).Value = el.href
Next el
Set htmlDocument = Nothing
Set fso = Nothing
End Sub
Cảm ơn bạn đã quan tâm bài viết. Đúng như bạn nói là link khi nhấn vào sẽ được chuyển đến trang khác. Với đoạn script là đoạn code random để chạy ngẫu nhiên các link trong thẻ list danh sách kia. Và những đường link đó tôi cũng muốn lấy. Nghĩa là trong tập html của web đó có đường link là sẽ lấy đấy bạn. Nhìn cách viết code của bạn thì hình như có thể lấy trực tiếp khi có địa chỉ trang web đó chứ không nhất thiết là một file txt đúng không. Hiện tại tôi không ngồi máy tính. Ngày mai tôi sẽ thử code của bạn.? Chân thành cảm ơn!
Cảm ơn bạn đã quan tâm bài viết. Đúng như bạn nói là link khi nhấn vào sẽ được chuyển đến trang khác. Với đoạn script là đoạn code random để chạy ngẫu nhiên các link trong thẻ list danh sách kia. Và những đường link đó tôi cũng muốn lấy. Nghĩa là trong tập html của web đó có đường link là sẽ lấy đấy bạn. Hiện tại tôi không ngồi máy tính. Ngày mai tôi sẽ thử code của bạn. Chân thành cảm ơn!
Ở bài #12 tôi đã có nói chỉ cần dùng đúng cái object để parse Dom Document là giản dị và chính xác.
Nhưng có lẽ bà con thấy cái code dùng Regex nên hứng chí thử vậy thôi.
Ở bài #12 tôi đã có nói chỉ cần dùng đúng cái object để parse Dom Document là giản dị và chính xác.
Nhưng có lẽ bà con thấy cái code dùng Regex nên hứng chí thử vậy thôi.
Giả sử sample.txt và tập tin Excel nằm cùng thư mục. Nếu khác thì sửa filename. Không phải chọn gì trong Tools cả.
Mã:
Sub Test()
Dim count As Long, filename As String, text As String
Dim htmlDocument As Object, fso As Object
Dim el As Object
Set htmlDocument = CreateObject("HtmlFile")
Set fso = CreateObject("Scripting.FileSystemObject")
filename = ThisWorkbook.Path & "\sample.txt"
htmlDocument.body.innerHTML = "<html><head>" & fso.OpenTextFile(filename).ReadAll
For Each el In htmlDocument.getElementsByTagName("a")
count = count + 1
Sheet1.Range("A" & count).Value = el.href
Next el
Set htmlDocument = Nothing
Set fso = Nothing
End Sub
