20090418_001_03

===

Dim s

txt_File01 = "file001.txt"
txt_File02 = "file002.txt"
txt_File03 = "file003.txt"

'txt_Regexp_Pattern01 = "class=r><a href=""[a-zA-Z1-90/&%=_\.\?\+\:\-;]+"""  ' 検索対象文字列

txt_Regexp_Pattern01 = "href="  ' 検索対象文字列
txt_Regexp_Pattern01 = "href=""[a-zA-Z1-90/&%=_\.\?\+\:\-;]+"""  ' 検索対象文字列

'WScript.Echo txt_Regexp_Pattern01

url_Val01 = "http://www.google.com/"
url_Val02 = "yourfilehost 声 でちゃう site:bbspink.com"

url_CurPath = "C:\Documents and Settings\user\My Documents\Work\w002\"

'対象画面を検索、なければ開く（必要に応じ使用してください）
Set xShell = CreateObject("Shell.Application")
win_s = False
For Each Window In xShell.Windows '対象URLが表示されているか？
 If TypeName(Window.Document) = "HTMLDocument" Then
  if Window.Document.url=url_Val01 then
     Set objIE0 = Window '対象URLが表示→その画面を使う
     win_s=true
     exit for
  end if
 end if
next

if win_s=false then '対象URLが非表示→新しく画面を開く

 Set objIE0 = CreateObject("InternetExplorer.Application")
 objIE0.Visible = True
 objIE0.Navigate url_Val01

 Do While objIE0.busy = True
    '空ループだと無駄にCPUを使うので250ミリ秒のインターバルを置く
    WScript.sleep(250)
 Loop

 Do While objIE0.document.readyState <> "complete"
 Loop
end if
'---header end---

'---以下操作コード、必要な部分をコピーしてください---
'objIE0.document.all.q.value=url_Val02 ' text index=2
'objIE0.document.all.Submit.click ' submit Submit ログイン or tags("INPUT").item(4).Click

on error resume next

'objIE0.document.form1.yourfilehosturl.value=url_Val02 ' text index=2
objIE0.document.f.q.value=url_Val02 ' text index=2

'objIE0.document.all.Submit.click ' submit Submit ログイン or tags("INPUT").item(4).Click
'objIE0.document.form1.Submit.click ' submit Submit ログイン or tags("INPUT").item(4).Click

'objIE0.document.gs.Submit.click ' submit Submit ログイン or tags("INPUT").item(4).Click

objIE0.document.f.Submit.click ' submit Submit ログイン or tags("INPUT").item(4).Click

 Do While objIE0.busy = True
    '空ループだと無駄にCPUを使うので250ミリ秒のインターバルを置く
    WScript.sleep(250)
 Loop

 Do While objIE0.document.readyState <> "complete"
 Loop

Set objFso02 = CreateObject("Scripting.FileSystemObject")

Set objFile02 = objFso02.OpenTextFile(url_CurPath & txt_File02, 2, True)

strBody = objIE0.Document.Body.InnerHtml

'objFile02.WriteLine "aaa " & vbcrlf &  vbcrlf & objIE0.Document.Body.InnerText
objFile02.WriteLine "aaa " & vbcrlf &  vbcrlf & strBody

Dim objRegExp       ' 正規表現オブジェクト
Dim objMatches      ' 検索結果
Dim objMatch        ' 検索結果
Dim strMessage      ' 表示メッセージ

Set objRegExp = New RegExp              ' 文字列検索・置換用オブジェクトの作成
with objRegExp
 .Global = True                 ' 文字列全体を検索するように指定

 .Pattern = txt_Regexp_Pattern01

 .IgnoreCase = True

 Set objMatches = .Execute(strBody)

end with

 objFile02.WriteLine "=================================="
 objFile02.WriteLine "=================================="
 objFile02.WriteLine "=================================="

i = 0

For Each objMatch In objMatches

 i = i + 1
 objFile02.WriteLine objMatch.Value

Next

objFile02.Close
Set objFile02 = Nothing
Set objFso02 = Nothing

 

WScript.Echo i



===