[[20140505115421]]　『VBA　WEBクエリ　実行時エラー1004「予期しないエ』（masa）　ページの最後に飛ぶ

『VBA　WEBクエリ　実行時エラー1004「予期しないエラーが発生」』（masa）

初めて質問させていただきます。
よろしくお願い致します。
ハイパーリンクからWEBのデータを取り込み、別シートに取り込もうとしていますが、
実行時エラー1004「予期しないエラーが発生」となり、.Refresh BackgroundQuery:=Falseのエラーとなります。
色々調べたのですが原因がわかりませんでした。
お手数ですがよろしくお願いいたします。

コードは以下になります。

Sub Macro1()
'
' Macro1 Macro
'
'

    ActiveCell.Offset(3, 3).Range("A1").Select
    Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
    Sheets("1").Select
    URL = Sheets("AAA").Cells(4, 12).Value
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;" & URL, Destination:=Range("A114"))
        .Name = "1"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlOverwriteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = False
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = "4"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = True
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False

    End With

End Sub

＜使用 Excel：Excel2013、使用 OS：Windows8 ＞

 正確にURLが指定されてない気がします
 Sheets("AAA").Cells(4, 12) のアドレスは正確ですか？
 クエリ取り込みのセル Range("A114") を選択して　Alt+F5 で更新されますか？
 Range("A114")選択、右クリックから[クエリの編集]で正確にサイトが表示されますか？
 .WebTables = "4"　 テーブルナンバーは合ってますか？
 最近はwebクエリで取り込めないサイトも増えてますね

 この部分は

    Sheets("1").Select
    url = Sheets("AAA").Cells(4, 12).Value
        With ActiveSheet.QueryTables.Add(Connection:= _
            "URL;" & url, Destination:=Range("A114"))
'            .Name = "1"
'            .FieldNames = True
'            .RowNumbers = False
'            .FillAdjacentFormulas = False
'            .PreserveFormatting = True
'            .RefreshOnFileOpen = False
'            .BackgroundQuery = True
            .RefreshStyle = xlOverwriteCells
'            .SavePassword = False
'            .SaveData = True
            .AdjustColumnWidth = False
'            .RefreshPeriod = 0
            .WebSelectionType = xlSpecifiedTables
            .WebFormatting = xlWebFormattingNone
            .WebTables = "4"
'            .WebPreFormattedTextToColumns = True
'            .WebConsecutiveDelimitersAsOne = True
'            .WebSingleBlockTextImport = False
'            .WebDisableDateRecognition = True
            .WebDisableRedirections = False
            .Refresh BackgroundQuery:=False
        End With

 通常はこれだけで問題ないと思います。

（jun53） 2014/05/05(月) 20:12

（jun53）様
ご回答ありがとうございます。
動作はマクロ実行→該当URL（（Sheets("AAA")）の（Cells(4, 12)）が開く→貼り付け先のシート（Sheets("1").Select）が開く
で、Refresh BackgroundQuery:=Falseのエラーとなります。
テーブルナンバーは手動でマクロを記録して確かめているので間違いないと思います。
貼り付け先のシートは開きますが、該当貼り付けセル（Destination:=Range("A114")）には移動していない気がします。
サイト側の問題ですかね？
もし解決策があればお教え下さい。
よろしくお願いいたします。
（masa） 2014/05/05(月) 22:53

 新しいシートで

 Option Explicit

 Const MASA As String = "URL;取り込みたいURL"

 Dim url As String

 Sub Macro1()

    Sheets("Sheet1").Select
    url = MASA
 '    url = Range("a1")

 '        With ActiveSheet.QueryTables.Add(Connection:= _
 '            "URL;" & url, Destination:=Range("A114"))
         With ActiveSheet.QueryTables.Add(Connection:= _
             url, Destination:=Range("A114"))

 '            .Name = "1"
 '            .FieldNames = True
 '             .RowNumbers = False
 '            .FillAdjacentFormulas = False
 '            .PreserveFormatting = True
 '            .RefreshOnFileOpen = False
 '            .BackgroundQuery = True
             .RefreshStyle = xlOverwriteCells
 '            .SavePassword = False
 '            .SaveData = True
             .AdjustColumnWidth = False
 '            .RefreshPeriod = 0
             .WebSelectionType = xlSpecifiedTables
             .WebFormatting = xlWebFormattingNone
            .WebTables = "4"
 '            .WebPreFormattedTextToColumns = True
 '            .WebConsecutiveDelimitersAsOne = True
 '            .WebSingleBlockTextImport = False
 '            .WebDisableDateRecognition = True
             .WebDisableRedirections = False

            .Refresh BackgroundQuery:=False
         End With

  End Sub

 これで取得できればクエリの前の問題
 取得できなければサイトの問題のような気がします

 新しいシートなので Range("A114") にあらかじめ 
 確実に開くwebクエリ作ってください

（jun53） 2014/05/05(月) 23:47

（jun53）様
再度のご回答ありがとうございます。
教えていただいたことをやってみましたが、上手く行きませんでした。
自分が作ったコードの.Refresh BackgroundQuery:=Falseを削除したところ、エラーは出なかったのですが貼り付けができていない状態で終わりました。？？
もっとVBAを勉強しないといけませんね。
ありがとうございます。

（masa） 2014/05/06(火) 16:13

コメント返信：

[ 一覧(最新更新順) ]

[[20140505115421]] 『VBA WEBクエリ 実行時エラー1004「予期しないエ』（masa） ページの最後に飛ぶ

[[20140505115421]]　『VBA　WEBクエリ　実行時エラー1004「予期しないエ』（masa）　ページの最後に飛ぶ