「EXCEL VBA」を使って、自分で指定したURLを自動的に開いて、そのソースを読んで、別のテキストファイルに保存する、というプログラムを作りたいと思っています。どのようにプログラムを書けばいいのかわかりません。どなたか、ソースを書いていただけないでしょうか?


たとえば、「http://www.yahoo.co.jp/」のURLを指定した場合は、自動的に、、「http://www.yahoo.co.jp/」のページを開いて、そのソースファイルを開いて、さらに、そのソースファイルを別のテキストファイルに保存する、という流れのプログラムがほしいのです。

よろしくお願いします。

回答の条件
  • 1人2回まで
  • 登録:2007/02/14 08:46:08
  • 終了:2007/02/15 11:12:22

ベストアンサー

id:llusall No.2

llusall回答回数505ベストアンサー獲得回数612007/02/14 09:32:58

ポイント50pt

こんな感じでしょうか?

Option Explicit

Public Sub GetHTML()

    'Sheet1のA1セルにURLを入力してから実行

    

    Const FILE_NAME As String = "D:\test.txt"

    Sheets("Sheet1").Select

    

    Dim url As String

    url = Range("A1").Value

    Dim xmlHttp

    Set xmlHttp = CreateObject("Msxml2.XMLHTTP")

    xmlHttp.Open "GET", url, False

    xmlHttp.send

    Dim html As String

    html = xmlHttp.responseText

    Set xmlHttp = Nothing

    Dim intFF As Integer

    intFF = FreeFile

    Open FILE_NAME For Output As #intFF

    Print #intFF, html

    Close #intFF

    MsgBox "おしまい"

End Sub

id:ysgear

ありがとうございます!!

確認してみました。

イメージどおりでした。

ありがとうございました!!!!

2007/02/15 11:00:06

その他の回答(3件)

id:taknt No.1

きゃづみぃ回答回数13539ベストアンサー獲得回数11982007/02/14 09:12:29

ポイント3pt

http://q.hatena.ne.jp/1165216591

こちらにあるソースで htmlを保存できるようです。

あとは、ソースを開くというのは どういう意味でしょうか?

メモ帳にソースが出てくればいいのでしょうか?

それとも エクセルのセルにソースをそれぞれ 入れればいいのでしょうか?

id:llusall No.2

llusall回答回数505ベストアンサー獲得回数612007/02/14 09:32:58ここでベストアンサー

ポイント50pt

こんな感じでしょうか?

Option Explicit

Public Sub GetHTML()

    'Sheet1のA1セルにURLを入力してから実行

    

    Const FILE_NAME As String = "D:\test.txt"

    Sheets("Sheet1").Select

    

    Dim url As String

    url = Range("A1").Value

    Dim xmlHttp

    Set xmlHttp = CreateObject("Msxml2.XMLHTTP")

    xmlHttp.Open "GET", url, False

    xmlHttp.send

    Dim html As String

    html = xmlHttp.responseText

    Set xmlHttp = Nothing

    Dim intFF As Integer

    intFF = FreeFile

    Open FILE_NAME For Output As #intFF

    Print #intFF, html

    Close #intFF

    MsgBox "おしまい"

End Sub

id:ysgear

ありがとうございます!!

確認してみました。

イメージどおりでした。

ありがとうございました!!!!

2007/02/15 11:00:06
id:Mook No.3

Mook回答回数1312ベストアンサー獲得回数3912007/02/14 09:44:34

ポイント40pt

IE の処理に関しては下記が参考になるでしょうか。

http://www.microsoft.com/japan/technet/scriptcenter/resources/qa...

VBA でのサンプルは次の通りです。

Private Declare Sub Sleep Lib "KERNEL32.dll" _
    (ByVal dwMilliseconds As Long)

Sub main()
    Call saveHtml("http://www.yahoo.com", "C:\yahoo.html")
End Sub

Sub saveHtml(url As String, filePath As String)
    Dim objIE As Object
    Set objIE = CreateObject("InternetExplorer.Application")
    
    '--- URL を読込
    objIE.Navigate url
    Do While objIE.busy = True
        Sleep 100
    Loop
    
    '--- ファイルを保存
    Open filePath For Output As #3
    Print #3, objIE.Document.Body.InnerHTML
    Close #3
    objIE.Quit
End Sub

ご参考までに。

id:ysgear

参考URL、ありがとうございます!!

イメージに近い感じです。

ソースもわかりやすく書いてくださって、ありがとうございます!!

2007/02/15 11:06:42
id:ardarim No.4

ardarim回答回数897ベストアンサー獲得回数1452007/02/15 03:19:05

ポイント22pt

サンプルです。

Option Explicit
Option Base 0

Sub test()

    If GetUrl("http://www.yahoo.co.jp/", "c:\yahoo.htm") Then
        MsgBox "成功"
    Else
        MsgBox "失敗"
    End If

End Sub

Function GetUrl(ByVal url As String, ByVal filename As String) As Boolean

    Dim i As Long, l As Long
    Dim fn As Integer
    Dim WinHttp As Object
    Dim html As String
    Dim b() As Byte
    
    On Error GoTo errorhandler
    
    Set WinHttp = CreateObject("WinHttp.WinHttpRequest.5.1")
    
    WinHttp.Open "GET", url, False
    WinHttp.Send
    
    If WinHttp.Status < 200 And WinHttp.Status > 399 Then
        GetUrl = False
        Exit Function
    End If
    
    l = LenB(WinHttp.ResponseBody)
    fn = FreeFile()
    Open filename For Binary Access Write As #fn
    html = WinHttp.ResponseBody
    ReDim b(l)
    For i = 1 To l
        b(i - 1) = AscB(MidB(html, i, 1))
    Next i
    Put #fn, , b
    Close #fn

    GetUrl = True
    On Error GoTo 0
    Exit Function
    
errorhandler:
    If fn <> 0 Then Close #fn
    GetUrl = False
    On Error GoTo 0
    
End Function

id:ysgear

ありがとうございます!!

きちんと実行することができました!!

2007/02/15 11:10:41

コメントはまだありません

この質問への反応(ブックマークコメント)

トラックバック

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません