• 締切済み

VB6でテレビ番組表HTMLの保存

VB6の以下のプログラムで下記URLのテレビ番組表を保存しようとしたのですが、うまくできませんでした。ソースを開いてみるとEUC-JPとなっていまして、これが原因かと思うのですが、保存するにはどうしたら良いでしょうか? よろしくお願いします。 ■URL http://tv.nikkansports.com/tv.php?site=007&mode=06&category=g&area=025&template=time&sdate=20081226&lhour=24&shour=5&arg=05 ■プログラム Private Sub Command1_Click() Dim strURL As String ' 取得URL Dim strFileName As String ' ファイル名 ' URLとファイル名を代入する strURL = Text1.Text strFileName = Text2.Text ' 指定されたURLのドキュメントをファイルに出力する Open strFileName For Output As #1 Print #1, Inet1.OpenURL(strURL) Close #1 MsgBox strURL & "を" & strFileName & "に出力しました" End Sub

みんなの回答

  • korin_
  • ベストアンサー率69% (46/66)
回答No.2

こんにちは。 テキストをEUC-JP形式で保存したいという事であれば、ADODB.Streamを使用すれば可能だと思います。 ご参考にどうぞ。 ------------------------------------------------- Dim Stream As Object Set Stream = CreateObject("ADODB.Stream") With Stream .Open .Type = 2 .Charset = "EUC-JP" .WriteText Inet1.OpenURL(strURL) .SaveToFile strFileName, 2 '上書き .Close End With Set Stream = Nothing

gmon_nx
質問者

補足

ご回答ありがとうございます。返信が遅くなってすみません。 これはどこに記述すれば良いのでしょうか? 質問文のソースに加えて記述するのでしょうか? すみませんが、あまり難しいことはわかりません。 もう少し詳しくお願いします。

  • yyr446
  • ベストアンサー率65% (870/1330)
回答No.1

やり方は若干違いますが、 Sub Main() Dim objXMLHttp As MSXML2.XMLHTTP objXMLHttp = CreateObject("Msxml2.XMLHTTP.3.0") Dim strURL As String Dim result As String strURL = "http://tv.nikkansports.com/tv.php?site=007&mode=06&category=g&area=025&template=time&sdate=20081226&lhour=24&shour=5&arg=05" objXMLHttp.open("GET", strURL, False) objXMLHttp.send("") result = objXMLHttp.responseText MsgBox(result) objXMLHttp = Nothing End Sub で、変数resultにドキュメントテキスト(そのページのソース) が取れます。 ※VBで、Microsoft XML v6.0を参照設定追加して下さい。 的外れな回答だったかも....

gmon_nx
質問者

補足

ご回答ありがとうございます。返信が遅くなってすみません。 参照設定なのですが、 Microsoft XML v6.0はなかったので、v3.0を使って試してみました。 しかし、objXMLHttp.open("GET", strURL, False) の行がコンパイルエラーになってしまいました。 どうしたら良いでしょうか?

関連するQ&A

  • 保存の仕方

    こんにちは、次のようなアドレスを入力するとそのソースを表示するプログラムを作ったのですがこれで表示されるソースに名前を付けて保存することってできますか?お願いします。 Private Sub Command1_Click() Dim strUrl As String Dim strBuf As String Command1.Enabled = False strUrl = InputBox("URLを入力して下さい.") If (Len(strUrl) = 0) Then Exit Sub End If Command1.Enabled = True strBuf = Inet1.OpenURL(strUrl) Form2.Show Form2.Text1.Text = strBuf End Sub Function Getsource() As String Dim strBuf As String Dim strUrl As String strBuf = Inet1.OpenURL(strUrl) 'ファイル内容を取得 Getsource = strBuf End Function

  • フレーム分割のソース表示プログラムについて

    以前次のようなプログラムを作ったのですが、これはURLを入力するとブラウザのソースを表示するものなので、フレームによって分割されたページのソースはすべて表示させることができません。このプログラムに何か追加して分割されていてもソースが表示できるようにしたいのですが。新たにコマンドを作ってやるしかないのでしょうか?何かアドバイスお願いします。 Private Sub Command1_Click() Dim strUrl As String Dim strBuf As String Command1.Enabled = False strUrl = InputBox("URLを入力して下さい.") If (Len(strUrl) = 0) Then Exit Sub End If Command1.Enabled = True strBuf = Inet1.OpenURL(strUrl) Form2.Show Form2.Text1.Text = strBuf End Sub Function Getsource() As String Dim strBuf As String Dim strUrl As String Dim strUrl2 As String strBuf = Inet1.OpenURL(strUrl) 'ファイル内容を取得 strUrl2 = InStr(strBuf, "frame src=") If strUrl2 > 0 Then strUrl3 = Mid(strBuf, strUrl2, 100) strUrl4 = Mid(strUrl3, 1, l) Getsource = strBuf End Function

  • プログラムについて

    今このようなプログラムを作っているのですが、わからなくて困っています。 Private Sub Command1_Click() Command1.Enabled = False 'タイマー無効 Text1.Text = GetSource() Command1.Enabled = True 'タイマー有効 Msg = "アドレスを入力して下さい" Title = "URL入力" Ret = InputBox(Msg, Title, "") End Sub Function GetSource() As String Dim strBuf As String Dim strURL As String strURL = "http://www.microsoft.com/japan/ms.htm" strBuf = Inet1.OpenURL(strURL) 'ファイル内容を取得 GetSource = strBuf End Function InputBoxにアドレスを書いてOKを押すと別ウィンドウでソースが表示されるプログラムを作りたいんです。お願いします。

  • ソース内の文字検索について

    下にHPのソースを表示させるプログラムがあります。 これで表示されたソースの中からある文字を検索したいのですが、それってできますか?どうしたらいいんでしょうか、お願いします。 Private Sub Command1_Click() Command1.Enabled = False Text1.Text = GetSource() Command1.Enabled = True End Sub Function GetSource() As String Dim strBuf As String Dim strURL As String strURL = "http://www.microsoft.com/japan/ms.htm" strBuf = Inet1.OpenURL(strURL) GetSource = strBuf End Function

  • FTPサーバからダウンロードするには?

    windowsXP,VB6,SP5で開発しています。 下のコードはヘルプからなんですが、 これをURLとファイル名を変更してやってみても、全然できません。 Private Sub Form_DblClick() Inet1.AccessType = icUseDefault Dim b() As Byte Dim strURL As String ' この URL は有効な URL であると仮定します。 strURL = "ftp://ftp.microsoft.com/" & _ "developr/drg/Win32/Autorun.zip" ' ファイルをバイト配列として取得します。 b() = Inet1.OpenURL(strURL, icByteArray) Open "C:\Temp\Autorun.zip" For Binary Access Write As #1 Put #1, , b() Close #1 MsgBox "完了しました。" End Sub ここの部分でタイムアウトになってしまいます。 b() = Inet1.OpenURL(strURL, icByteArray) FTPサーバのアドレスとかちゃんとあってます。 どなたか、解決方法をご教授くださいませm(_ _)m

  • VB ファイル保存

    XMLファイルに設定情報を保存仕様としているのですが,ある所でエラーが出てうまく走りません. 下記がそのプログラムになりますが,XMLファイルに保存のコメント下の所でエラーになります. エラーの内容は「保護レベルの設定が原因で'windowsApplication1.Form2'にアクセスできません」 です. どなたかご教示のほどよろしくお願いいたします. Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click 'ファイルが存在しない場合に新規にブランクファイルを作成する 'XMLファイルパス Dim xmlFile1 As String = "C:\OBS_Setting.xml" Dim hStream As System.IO.FileStream 'XMLファイルが存在するか確認 If Dir(xmlFile1) = "" Then ' 指定したパスのファイルを作成する hStream = System.IO.File.Create(xmlFile1) ' hStream が破棄されることを保証するために Try ~ Finally を使用する Try ' hStream が閉じられることを保証するために Try ~ Finally を使用する Try Finally ' 作成時に返される FileStream を利用して閉じる If Not hStream Is Nothing Then hStream.Close() End If End Try Finally ' hStream を破棄する If Not hStream Is Nothing Then Dim cDisposable As System.IDisposable = hStream cDisposable.Dispose() End If End Try End If 'XMLファイルに設定データを保存する Dim Area As String = ComboBox1.Text Dim State As String = ComboBox2.Text Dim City As String = ComboBox3.Text Dim BefY As String = ComboBox4.SelectedIndex Dim AftY As String = ComboBox5.SelectedIndex Dim BefM As String = ComboBox6.SelectedIndex Dim AftM As String = ComboBox7.SelectedIndex '保存するオブジェクトの配列を作成 '保存するオブジェクトの配列を作成 Dim myClasses(6) As SampleClass myClasses(0) = New SampleClass() myClasses(0).Number = 0 myClasses(0).Message = Area myClasses(1) = New SampleClass() myClasses(1).Number = 1 myClasses(1).Message = State myClasses(2) = New SampleClass() myClasses(2).Number = 2 myClasses(2).Message = City myClasses(3) = New SampleClass() myClasses(3).Number = 3 myClasses(3).Message = BefY myClasses(4) = New SampleClass() myClasses(4).Number = 4 myClasses(4).Message = AftY myClasses(5) = New SampleClass() myClasses(5).Number = 5 myClasses(5).Message = BefM myClasses(6) = New SampleClass() myClasses(6).Number = 6 myClasses(6).Message = AftM 'XMLファイルに保存 Dim serializer As New System.Xml.Serialization.XmlSerializer(GetType(SampleClass())) Dim fs1 As New IO.FileStream(xmlFile1, IO.FileMode.Create) serializer.Serialize(fs1, myClasses) fs1.Close() End Sub 'XMLファイルに保存するオブジェクトのためのクラス Public Class SampleClass Public Number As Integer Public Message As String End Class

  • SAVEダイアログを使用する場合の保存名の指定

    下記のとおり、SAVEダイアログを使用してデータを保存するプログラムを使用したのですが、保存の際に予めファイル名称を指定したいと考えています。 ネットで色々調べたのですが、どれもうまくいかなかったので教えて下さい。 環境はVB2008、windosXP(SP3)です。 Private Sub Command3_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles Command3.Click  Dim nFilter As String  Dim Ret As String  Dim ReadData As String  'フィルターの設定  nFilter = "データファイル(*.dat)" & Chr(0) & "*.dat" & Chr(0)  Ret = SaveDlg(Me.Handle.ToInt32, nFilter)  'ファイルを保存する  FileOpen(1, Ret, OpenMode.Output)  WriteLine(1, Text1.Text)  WriteLine(1, Text2.Text)  WriteLine(1, Text3.Text)  FileClose(1) End Sub

  • VBからExcelのテキストを指定して開きたい

     VBのアプリケーションから文書名を指定してエクセルを起動したいのですが 出来なくて困っています。ちなみにコードは下記のとおりです。どこに問題があ るのか教えていただけないでしょうか。 Private Sub Command1_Click() Dim lngReturnCode As Long Dim strFileName As String strFileName = "AllTitles.csv"   lngReturnCode = ShellExecute(Me.hwnd, _ "open c:\***\***.xls", _ strFileName, _ vbNullString, _ App.Path, _ SW_SHOWNORMAL) End Sub

  • HTTPサーバーへPOST要求を送信について

    はじめまして、ひろです。 VisualBasic 2008 .NETでHTTPサーバーへPOST要求を送信する プログラムを作成しているのですが、うまく動作しません。 仕様書でクライアントからサーバーへ 要求URL:https://ABC.co.jp 要求HEADER:POST https://ABC.co.jp HTTP/1.0 要求BODY:A=1234 POST要求するよう指示されているのですが、 下記のようなプログラムではERRORが返ってきます。 問題ある箇所がわかる方いらっしゃたら、 教えてほしいのですが。 よろしくお願いします。 Sub aaabbb() Dim objXML As Object Dim strXMLDoc As String Dim intRet As Integer Dim strURL As String Dim strKey As String strURL = "https://ABC.co.jp" strKey = "A=1234" objXML = CreateObject("MSXML2.ServerXMLHTTP") objXML.open("POST", strURL, False) objXML.send(strKey) strXMLDoc = objXML.responseText intRet = objXML.status objXML = Nothing End Sub

  • 名前を付けて保存時のファイル名の指定

    ボタンを押すとテーブルのデータが出力できるようにしたいと思います。 標準Module1とFormのボタンには下記のような記述をしていますが 添付ファイルのように保存のダイアログまではうまく動いているようです。 ただ、ファイル名がブランクですので、"表示材料_" & Format(Now(), "yyyymmdd")と自動的に表示させたいです。 ご教授お願いいたします。 【PC環境】 Access:2010 WIndows 7 【標準Module1】 Function GetFileName(OpenOrSaveFlg As Boolean, strFilter As String, _ strTitle As String) As String Dim returnValue As Integer Dim strFilePath As String If strFilter = "" Then strFilter = "全てのファイル (*.*)|*.*" End If WizHook.Key = 51488399 'WIZHOOK有効 returnValue = WizHook.GetFileName( _ 0, "", strTitle, "", strFilePath, "", _ strFilter, _ 0, 0, 0, OpenOrSaveFlg _ ) WizHook.Key = 0 ' WizHook 無効 GetFileName = strFilePath End Function 【Fromのボタン】 Private Sub コマンド28_Click() Dim strFileName As String Dim ExpFileName As String ExpFileName = "表示材料_" & Format(Now(), "yyyymmdd") strFileName = GetFileName(False, "MicrosoftExcel ブック (*.xls)|*.xls", "") If Len(strFileName) = 0 Then 'キャンセルボタンが押されたときの処理を記述 MsgBox "キャンセルが押されました。" Else DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "T_WO_MAT", "", True, "" End If End Sub

専門家に質問してみよう