webｻｲﾄからﾏｸﾛでﾃﾞｰﾀを抽出してｴｸｾﾙ形式のﾃﾞｰﾀを得たいです｡具体的ﾍﾟｰｼﾞとして https://www.jetro.go.jp/j-messe/?action_fairList=true&page=1&limit=1…

こんな感じで｡
ｱｸﾃｨﾌﾞなｼｰﾄの 2行目から､題名､開催地､期間､概要を書きだします｡

Sub 展示会情報を抽出()
 Set xhr = CreateObject("MSXML2.XMLHTTP")
 URL = "https://www.jetro.go.jp/j-messe/?action_fairList=true&page=1&limit=100"
 xhr.Open "GET", URL, False
 xhr.send ""
 If xhr.StatusText = "OK" Then
 Set doc = CreateObject("htmlfile")
 doc.write xhr.responseText
 Set divList = doc.getElementsByTagName("DIV")
 For i = 0 To divList.Length - 1
 r = 2  ' 一行目はﾀｲﾄﾙ行
 If divList(i).className = "elem_text_list_news" Then
 Set Item = divList(i).FirstChild
 Do While Not Item Is Nothing
 Set Data = Item.getElementsByTagName("DD")
 Set Title = Data(0).FirstChild
 Set eventDate = Title.NextSibling
 Set place = eventDate.NextSibling
 Set Comment = place.NextSibling
 Cells(r, 1).Value = title.innerText
 Cells(r, 2).Value = place.innerHTML
 Cells(r, 3).Value = eventDate.innerHTML
 Cells(r, 4).Value = comment.innerHTML

 Set Item = Item.NextSibling
 r = r + 1
 If r > 200 Then  ' 念のため
 Exit For
 End If
 DoEvents
 Loop
 Exit For
 End If
 DoEvents
 Next
 Set doc = Nothing
 End If
 Set xhr = Nothing
End Sub

追記です｡

欲しいのは日本開催の展示会全部なのですが
それは可能でしょうか？

絞り込んだ地域などをﾊﾟﾗﾒｰﾀ渡しではなくｾｯｼｮﾝで持っているようなので､ﾃﾞｰﾀの取り方を変えました｡
こんな感じです｡
｢展示会情報を抽出｣ｻﾌﾞﾙｰﾁﾝを呼び出してください｡

Sub nav(oIE, sURL)
 oIE.Navigate sURL
 Do While oIE.Busy
 Application.Wait DateAdd("s", 1, Now)
 Loop
End Sub

Function nextElement(e)
 Do While Not e Is Nothing
 If e.NodeType = 1 Then
 Exit Do
 End If
 Set e = e.NextSibling
 Loop
 Set nextElement = e
End Function

Sub 展示会情報を抽出()

 Set oIE = CreateObject("InternetExplorer.Application")

 oIE.Visible = False

 sURL = "https://www.jetro.go.jp/j-messe"
 Call nav(oIE, sURL)
 Cells(2, 1).Value = "■"

 sURL = "https://www.jetro.go.jp/j-messe/?action_fairList=true&type=v1&v_2=009"
 Call nav(oIE, sURL)
 Cells(2, 1).Value = "■■"

 sURL = "https://www.jetro.go.jp/j-messe/?action_fairList=true&type=v2&v_2=009&v_3=002"
 Call nav(oIE, sURL)
 Cells(2, 1).Value = "■■■"

 sURL = "https://www.jetro.go.jp/j-messe/?action_fairList=true&page=1&limit=100"
 Call nav(oIE, sURL)
 Cells(2, 1).Value = "■■■■"

 Set oDoc = oIE.document
 Set vvv = oDoc.querySelectorAll("DIV.elem_text_list_news DD")

 For i = 0 To vvv.Length - 1
 Set data = vvv.Item(i)
 Set Title = nextElement(data.FirstChild)
 Set eventDate = nextElement(Title.NextSibling)
 Set place = nextElement(eventDate.NextSibling)
 Set Comment = nextElement(place.NextSibling)
 r = i + 2
 Cells(r, 1).Value = Title.innerText
 Cells(r, 2).Value = place.innerText
 Cells(r, 3).Value = eventDate.innerText
 Cells(r, 4).Value = Comment.innerText
 Range(Cells(r, 1), Cells(r, 4)).WrapText = False

 DoEvents
 Next

 oIE.Quit
 Set oIE = Nothing
End Sub

最初からﾍﾟｰｼﾞをたどっていくので､かなり遅くなっちゃいました｡
最終的な一覧ﾍﾟｰｼﾞにたどり着くのに少々待たされるので､A2 のｾﾙに簡易的に進捗状況を表示するようにしてます｡
■が四つになると一覧のﾍﾟｰｼﾞにたどり着いています｡

追記です｡
新しめのﾒｿｯﾄﾞが駄目なのかな､ということで､古くからあるﾒｿｯﾄﾞだけで書き直してみたものです｡

Sub nav(oIE, sURL)
 oIE.Navigate sURL
 Do While oIE.Busy
 Application.Wait DateAdd("s", 1, Now)
 Loop
End Sub

Function nextElement(e)
 Do While Not e Is Nothing
 If e.NodeType = 1 Then
 Exit Do
 End If
 Set e = e.NextSibling
 Loop
 Set nextElement = e
End Function

Sub 展示会情報を抽出()

 Set oIE = CreateObject("InternetExplorer.Application")

 oIE.Visible = False

 sURL = "https://www.jetro.go.jp/j-messe"
 Call nav(oIE, sURL)
 Cells(2, 1).Value = "■"

 sURL = "https://www.jetro.go.jp/j-messe/?action_fairList=true&type=v1&v_2=009"
 Call nav(oIE, sURL)
 Cells(2, 1).Value = "■■"

 sURL = "https://www.jetro.go.jp/j-messe/?action_fairList=true&type=v2&v_2=009&v_3=002"
 Call nav(oIE, sURL)
 Cells(2, 1).Value = "■■■"

 sURL = "https://www.jetro.go.jp/j-messe/?action_fairList=true&page=1&limit=100"
 Call nav(oIE, sURL)
 Cells(2, 1).Value = "■■■■"

 Set oDoc = oIE.document
 Set ddList = oDoc.getElementsByTagName("DD")
 r = 2
 For i = 0 To ddList.Length - 1
 If ddList(i).ParentNode.ParentNode.className = "var_ptb10 elem_text_list_news_pad" Then
 Set Data = ddList(i)
 Set Title = nextElement(Data.FirstChild)
 Set eventDate = nextElement(Title.NextSibling)
 Set place = nextElement(eventDate.NextSibling)
 Set Comment = nextElement(place.NextSibling)
 Cells(r, 1).Value = Title.innerText
 Cells(r, 2).Value = place.innerText
 Cells(r, 3).Value = eventDate.innerText
 Cells(r, 4).Value = Comment.innerText
 Range(Cells(r, 1), Cells(r, 4)).WrapText = False
 r = r + 1
 End If
 DoEvents
 Next

 oIE.Quit
 Set oIE = Nothing
End Sub