|
チェックするURL内のリンク先がセルB10から表示されています。
|
|
|
| シートコード |
|
下記のコードを入力してください。
'リンクを取り出しセルに記入する
Private Function ExGetLink(lrow As Long, lcol As Long) As Long
Dim i As Integer
Dim s1 As String
For i = 0 To tIEobj.document.Links.Length - 1
If Left(tIEobj.document.Links(i).href, 4) = "http" Then
'セルに記入
Cells(lrow + i, lcol) = tIEobj.document.Links(i).href
End If
Next
ExGetLink = tIEobj.document.Links.Length
End Function
下記のコードに変更してください。
Private Sub CommandButton1_Click()
Dim llink As Long
If TextBox1 = "" Then
MsgBox "チェックするURLを入力してください。"
TextBox1.Activate
Exit Sub
End If
Cells.Clear
'IEオープン
If ExCreateIEobject Then
'リンクを取り出しセルに記入する
llink = ExGetLink(10, 2)
End If
On Error Resume Next
tIEobj.Quit
Set tIEobj = Nothing
End Sub
|
|
|
|
|
|
|
|