人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

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

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

よろしくお願いします。

●質問者: ysgear
●カテゴリ:コンピュータ インターネット
✍キーワード:Excel URL VBA ソース テキスト
○ 状態 :終了
└ 回答数 : 4/4件

▽最新の回答へ

1 ● きゃづみぃ
●3ポイント

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

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

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

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

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


2 ● llusall
●50ポイント ベストアンサー

こんな感じでしょうか?

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

◎質問者からの返答

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

確認してみました。

イメージどおりでした。

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


3 ● Mook
●40ポイント

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

ご参考までに。

◎質問者からの返答

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

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

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


4 ● ardarim
●22ポイント

サンプルです。

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

◎質問者からの返答

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

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

関連質問


●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ