- 日時: 2013/02/02 16:15
- 名前: VBレスキュー(花ちゃん)
- ***********************************************************************************
* カテゴリー:[インターネット][エクセル][] * * キーワード:Webクエリ,Excel,QueryTable,表データー,HTMLファイル,Web上のデーター * *********************************************************************************** '=================================================================================================== '投 稿 日:2012.04.22 '投 稿 者:VBレスキュー(花ちゃん) 'SampleNo:451 2012.04.21 @ 2012.04.21 'タイトル:Excel2010のWEBクエリをVB2010から操作する(451) - VB2010 '動作確認:WindowsVista / Windows 7 / Excel 2007/2010 VB2010 / Framework 4 / ターゲットCPU:X86 '[Option Compare Text] [Option Explicit On] [Option Infer On] [Option Strict On]で設定 '--------------------------------------------------------------------------------------------------- 'プロジェクト→参照の追加→COM→Microsoft Excel *.* ObjectLibrary を参照設定しておいてください。 'ソースコードは、保存オプションの詳細設定で、日本語(シフトJIS)-コードページ932 で保存しております。 '========1=========2=========3=========4=========5=========6=========7=========8=========9=========0 エクセルの Web クエリ(メニューのデータ→Web クエリ)を VB2010 上から操作して、Web 上の HTMLファイル内の表データーを取得してみました。
レイアウトは、下図を参照して下さい。
TextBox1.Text = "http://www.jma.go.jp/jp/amedas_h/today-60196.html?groupCode=43&areaCode=000" TextBox2.Text = "5" 又は、 TextBox2.Text = "4,5"
又は、
TextBox1.Text = "http://www.hanatyan.sakura.ne.jp/patio/patio2.cgi" TextBox2.Text = "1" でプロパティを設定して下さい。(他の設定の場合エラーが出たりするかも知れませんの事前にマクロ を取るなりして確認しておいて下さい。)
テーブル内の表データーの文字列内に改行コードが含まれている場合は、同一行として取得できない。 事前に Index 番号を取得するようなプロパティ・メソッドが見当たらない。 等の課題がありますが(ご存知の方は一報を)取りあえず単純な表データーの取得には便利かと思います。 近々に、別方法をアップしたいと思っておりますが、エクセルの Web クエリを使った方法をマスター (理解)して置いて下さい。
--------------------------------------------------------------------------------------------------- Imports Microsoft.Office.Interop
Public Class Form1
Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click 'Excel の起動・終了等は、.NETからExcelの基本的な操作方法 をご覧ください。 Call ExcelOpen("", "") '新規ファイルでオープン
'================== Webクエリ機能を使ってデーターの取り込み ================== '取り込んだデーターの表示開始位置を指定 Dim xlRange As Excel.Range = xlSheet.Range("A1") '取り込み先のデーターファイルの URL 又は、パス Dim filePath As String = "URL;" & TextBox1.Text Dim xlQTs As Excel.QueryTables = xlSheet.QueryTables '指定の htm ファイルのクエリ テーブルを新規作成 Dim xlQT As Excel.QueryTable = xlQTs.Add(Connection:=filePath, Destination:=xlRange) 'テーブル作成時の条件を設定(別途、Excel VBA のヘルプで、[QueryTable オブジェクト メンバ]を 'ご覧下さい。) With xlQT .PreserveFormatting = True '最初の 5 行の共通の書式がデータの新しい行に適用 ' "" の場合すべてのデーターを取得 If TextBox2.Text.Length > 0 Then 'テーブル No. は、現時点で 5 になっておりますが、サイトの変更に合わせて変更して下さい。 .WebTables = TextBox2.Text '該当のテーブル End If .Refresh(BackgroundQuery:=False) 'QueryTable を更新します End With MRComObject(xlRange) MRComObject(xlQT) MRComObject(xlQTs) '========================================================================================
xlApp.Visible = True 'Excelを表示(必ずとも表示しなくてもよい) '確認のため5秒間表示(実使用時は、必要なし) System.Threading.Thread.Sleep(5000)
'Excelファイルを上書き保存(True 又省略すれば)して終了処理を実行 Call ExcelClose(IO.Path.GetFullPath(".\Test.xlsx"), True) 'False の場合保存しないで終了
'Excel.EXE がタスクマネージャに残っていないか調査(実使用時は必要なし) Call ProcessCheck()
End Sub
'=========================================================================================== ' 今後の Excel のサンプルは、下記の起動・終了処理のコードを省略した場合は、下記のコードを ' ご利用願います。 ' Excel の基本的な操作方法については、下記リンク先等をご覧下さい。 ' http://www.hanatyan.sakura.ne.jp/dotnet/Excel01.htm '===========================================================================================
#Region "Excel の起動・終了に関する設定"
'---------- Private な変数の宣言 ----------------------------------- Private xlApp As Excel.Application Private xlBooks As Excel.Workbooks Private xlBook As Excel.Workbook Private xlSheets As Excel.Sheets Private xlSheet As Excel.Worksheet
Private Sub ExcelOpen(ByVal FilePath As String, ByVal SheetName As String) 'Excel のオープン処理用プロシージャ xlApp = New Excel.Application xlBooks = xlApp.Workbooks If FilePath.Length = 0 Then '新規のファイルを開く場合 xlBook = xlBooks.Add xlSheets = xlBook.Worksheets xlSheet = CType(xlSheets.Item(1), Excel.Worksheet) Else '既存のファイルを開く場合 xlBook = xlBooks.Open(FilePath) xlSheets = xlBook.Worksheets xlSheet = CType(xlSheets(SheetName), Excel.Worksheet) End If 'xlApp.Visible = True End Sub
Private Sub ExcelClose(ByVal FilePath As String, Optional ByVal CancelSave As Boolean = True) 'Excelファイルを上書き保存して終了処理用プロシージャ xlApp.DisplayAlerts = False '保存時の問合せのダイアログを非表示に設定 If CancelSave Then xlSheet.SaveAs(FilePath) 'ファイルに保存 End If MRComObject(xlSheet) 'xlSheet の解放 MRComObject(xlSheets) 'xlSheets の解放 xlBook.Close() 'xlBook を閉じる MRComObject(xlBook) 'xlBook の解放 MRComObject(xlBooks) 'xlBooks の解放 xlApp.Quit() 'Excelを閉じる MRComObject(xlApp) 'xlApp を解放 End Sub
Private Sub ProcessCheck() 'タスクマネージャに、Excel.exe が残っていないか確認(通常は必要なし) System.Threading.Thread.Sleep(500) Application.DoEvents() If Process.GetProcessesByName("Excel").Length = 0 Then '先にフォームを閉じるとエラーが発生するので '必要により表示するようにして下さい。 MessageBox.Show(Me, "Excel.EXE は解放されました。") Exit Sub End If If Process.GetProcessesByName("Excel").Length >= 1 Then MessageBox.Show("まだ Excel.EXE が起動しています。") End If End Sub
Public Shared Sub MRComObject(Of T As Class)(ByRef objCom As T, Optional ByVal force As Boolean = False) If objCom Is Nothing Then Return End If Try If System.Runtime.InteropServices.Marshal.IsComObject(objCom) Then If force Then System.Runtime.InteropServices.Marshal.FinalReleaseComObject(objCom) Else Dim count As Integer = System.Runtime.InteropServices.Marshal.ReleaseComObject(objCom) ' Debug.Print(count.ToString) End If End If Finally objCom = Nothing End Try End Sub
#End Region
End Class
※ 実行結果等の図(画像をクリックすると元のサイズで見る事ができます。)
|