サンプル投稿用掲示板 VB2005 ～ 用トップページ VB6.0 用 トップページ
- 日時： 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
※
実行結果等の図(画像をクリックすると元のサイズで見る事ができます。)
 |
