質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
85.47%
VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

Q&A

解決済

1回答

3849閲覧

VBA コンパイルエラー表示が出る

nanalabo

総合スコア6

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

0グッド

0クリップ

投稿2019/09/19 06:50

編集2019/09/19 06:59

前提・実現したいこと

※VBA初心者です。
コピペでできるはずがエラーが出ます。
エラーが出るのが分からないので教えていただきたいです。

発生している問題・エラーメッセージ

コンパイル エラー: ユーザ定義型は定義されていません。 Sub GetGoogleSuggestions(KeyUrl, KeyWord)

該当のソースコード

Option Explicit Dim ws1 As Worksheet Sub AllProcedures() Dim KeyWord As String, KeyUrl As String Set ws1 = Worksheets("キーワード一覧") KeyWord = InputBox("調査したいキーワードを入力する") KeyUrl = "https://www.google.co.jp/search?q=" & KeyWord Call GetGoogleSuggestions(KeyUrl, KeyWord) ws1.Range("A4").Value = "検索キーワード:" & KeyWord Dim d As String KeyWord = Replace(KeyWord, "/", "") KeyWord = Replace(KeyWord, ":", "") d = Right(Replace(Date, "/", ""), 6) ThisWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & d & "_" & KeyWord End Sub Sub GetGoogleSuggestions(KeyUrl, KeyWord) Set ws1 = Worksheets("キーワード一覧") Dim HttpReq As XMLHTTP60 Set HttpReq = New XMLHTTP60 HttpReq.Open "GET", KeyUrl HttpReq.send Do While HttpReq.readyState < 4 DoEvents Loop Dim oHtml As New MSHTML.HTMLDocument Dim objTag As Object Dim PageTitle As String Dim ContentsURL As String Dim Counter As Long Counter = 1 oHtml.body.innerHTML = HttpReq.responseText For Each objTag In oHtml.getElementsByTagName("a") If InStr(objTag.outerHTML, "LC20lb") > 0 Then PageTitle = objTag.innerText ContentsURL = objTag Call GetContentsEachPage(ContentsURL, PageTitle, Counter) Counter = Counter + 1 End If Next Continue: Set HttpReq = Nothing End Sub Sub GetContentsEachPage(ContentsURL As String, PageTitle As String, Counter As Long) Set ws1 = Worksheets("キーワード一覧") Dim objTag As Object Dim i As Long, j As Long, cmax As Long Dim cmax1 As Long, cmax2 As Long, cmax3 As Long Dim x As Long, p As Long, a As Long Dim myH2() As String, myH3() As String, myBody As Variant Dim Keys As Variant Dim myDic As Object Set myDic = CreateObject("Scripting.Dictionary") i = 0 j = 0 Dim HttpReq As XMLHTTP60 Set HttpReq = New XMLHTTP60 HttpReq.Open "GET", ContentsURL HttpReq.send Do While HttpReq.readyState < 4 DoEvents Loop Dim oHtml As New MSHTML.HTMLDocument oHtml.body.innerHTML = HttpReq.responseText myBody = Split(oHtml.body.outerHTML, vbCrLf) For Each objTag In oHtml.getElementsByTagName("H2") ReDim Preserve myH2(i) myH2(i) = objTag.innerText i = i + 1 Next For Each objTag In oHtml.getElementsByTagName("H3") ReDim Preserve myH3(j) myH3(j) = objTag.innerText j = j + 1 Next For x = LBound(myBody) To UBound(myBody) If InStr(myBody(x), "H2") > 0 Or InStr(myBody(x), "H3") > 0 Then For i = LBound(myH2) To UBound(myH2) If InStr(myBody(x), myH2(i)) > 0 Then myDic.Add "H2-" & x, myH2(i) GoTo Continue End If Next For j = LBound(myH3) To UBound(myH3) If InStr(myBody(x), myH3(j)) > 0 Then myDic.Add "H3-" & x, myH3(j) GoTo Continue End If Next Continue: End If Next cmax2 = ws1.Range("C1048576").End(xlUp).Row + 1 cmax3 = ws1.Range("D1048576").End(xlUp).Row + 1 cmax = cmax2 If cmax3 > cmax2 Then cmax = cmax3 End If ws1.Range("A" & cmax).Value = Counter With ws1 .Range("B" & cmax).Value = PageTitle .Range("B" & cmax).WrapText = False .Hyperlinks.Add anchor:=.Range("B" & cmax), Address:=ContentsURL End With cmax = cmax + 1 For Each Keys In myDic If Left(Keys, 2) = "H2" Then ws1.Range("C" & cmax).Value = myDic.Item(Keys) cmax = cmax + 1 ElseIf Left(Keys, 2) = "H3" Then ws1.Range("D" & cmax).Value = myDic.Item(Keys) cmax = cmax + 1 End If Next Set HttpReq = Nothing End Sub

以上です。

気になる質問をクリップする

クリップした質問は、後からいつでもMYページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

y_waiwai

2019/09/19 06:56

エラーメッセージを提示しましょう エラーメッセージは不要な省略翻訳せず、そのままコピペで提示してください。 質問は編集できるので追記しましょう
nanalabo

2019/09/19 06:57

ありがとうございます。 修正します。
guest

回答1

0

ベストアンサー

参照設定がされていないことが原因です。

メニューバー > ツール > 参照設定 …から以下の項目のチェックをONにしてみてください。
Microsoft XML, v6.0
Microsoft HTML Object Library

今回の場合のような問題の解決方法は、表示されるエラメーッセージとエラーの発生時にハイライトされる行内容をもとに「ユーザ定義型は定義されていません XMLHTTP60」といったキーワードで検索することで見つかります。

投稿2019/09/19 07:04

ku__ra__ge

総合スコア4524

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

nanalabo

2019/09/19 07:16

参照設定を変更いたしました! ご教授頂きありがとうございます。
guest

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
85.47%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問