FireFox VBScript Excel 2013 Later わがまま日本仕様 引数で空白 yahoo 検索 HPジャンプを使い分ける

Excel 2013 Later

このVbscriptはURLEncodeという関数を使います。
Excel 2010まではJscriptで検索文字列をEncodeできました。
しかし、Excel2013以降64bitを入れているとJscriptはエラーになります。
そこでURLEncodeを使います。

わがまま日本仕様

何とかドットジェーピー的なものはURLにしたい
日本語は検索にしたい
urlっぽいものはURLにしたい
about:blankは空白のページ
なにも引数がないならYahoo
自分で言うのもなんだけど、まじでわがままだ…

というかアドレスバー入力が確実に

日本語だと確実に検索ができます。

機能解説

URLの判定

2つのパターンと

VBAで文字列がURLとして正しいかどうかを正規表現を使って判断する方法
[digital]URLにマッチする正規表現
と

わがままパターン

3文字から20字まで
英数字ドットコム google.com
英数字ドットJp tenki.jp
英数字ドットcoドットjp yahoo.co.jp
英数字ドットgoドットjp jma.go.jp
の三パターンをURLとするMyPatternでどれか一つに当たったらURLと判定します。

Function blURL(buf)
Dim Reg : Set Reg  =  CreateObject("VBScript.RegExp")
DIm strPtn
With Reg
.Global=true
.Multiline=false
.IgnoreCase = True
'http://blog.mamohacy.com/entry/2011/12/09/165725
strPtn = "^(https*|ftp)://[-_!~';:@&=,%#/a-zA-Z0-9\$\*\+\?\.\(\)]+$"
.Pattern =strPtn
If .Test(buf) =True Then blURL=True :exit function
'[2007年02月07日 URLにマッチする正規表現（VB）](http://d.hatena.ne.jp/kdoi/20070207/1170861517)
strPtn ="https?://(([-_.!~*'()a-zA-Z0-9;:&=+$,]|%[0-9A-Fa-f][0-9A-Fa-f])*@)?((([a-zA-Z0-9]|" _ 
& "[a-zA-Z0-9][-a-zA-Z0-9]*[a-zA-Z0-9])\.)*([a-zA-Z]|[a_-zA-Z][-a-zA-Z0-9]*[a-zA-Z0-9])\.?|" _ 
& "[0-9]+\.[0-9]+\.[0-9]+\.[0-9]+)(:[0-9]*)?(/([-_.!~*'()a-zA-Z0-9:@&=+$,]|" _ 
& "%[0-9A-Fa-f][0-9A-Fa-f]_)*(;([-_.!~*'()a-zA-Z0-9:@&=+$,]|%[0-9A-Fa-f][0-9A-Fa-f])*)*(/([-_.!~*'()a-zA-Z0-9:@&=+$,]|" _ 
& "%[0-9A-Fa-f][0-9A-Fa-f])*(;([-_.!~*'()a-zA-_Z0-9:@&=+$,]|%[0-9A-Fa-f][0-9A-Fa-f])*)*)*)?(\?([-_.!~*'()a-zA-Z0-9;/?:@&=+$,]|%[0-9A-Fa-f][0-9A-Fa-f])*)?(#([-_.!~*'()a-zA-Z0-9;/?:@&_=+$,]|%[0-9A-Fa-f][0-9A-Fa-f])*)?"
.Pattern =strPtn
If .Test(buf) =True Then blURL=True :exit function
'
strPtn="^[0-9A-z]{3,20}\.com$|^[0-9A-z]{3,20}\.co\.jp$|^[0-9A-z]{3,20}\.jp$|^[0-9A-z]{3,20}\.go\.jp$"
.Pattern =strPtn
If .Test(buf) =True Then blURL=True : exit function
End With
blURL=False
End Function

URLEncode

以前の記事のとおりです。
EXCEL2013以降64BIT版で簡単URLエンコード EXCEL2013 Later URLEncode Function
https://qiita.com/Q11Q/items/cbaa8c465f07164bd0db
3000Hitしており恐縮です...

Main

FiefoxをVBSで呼び出す基本

新たなタブが開かれる仕様に変更

objShell.Run """C:\Program Files\Mozilla Firefox\firefox.exe"" ""http://★★★/" & Sid & """", vbNormalFocus, False

のsidっているのかな...たしかにないと、既存のFirefoxに新たなタブとして開かれます。Sidを追加すると新たにFirefoxが立ち上がり、URLとSid/というページができます。まだバグっているのかも。
とりあえず新しいタブが追加される仕様です。

Googleの検索文字列の参考

WebクエリでGoogleの検索結果を取得する

Wscirpt.Arguments

引数が入るようにするため導入、一つしか拾いません。もしなければYahooに飛びます。

わがままabout:blankで空白のページ

なにもない時もいるでしょう

わがままURL判定

URLか判定して検索するか考えます

URLでなければ検索する

URL判定がFALSEならExcelを使って検索文字列を作り、Googleに入れます。

使い方

D:\ff.vbsとして保存

このように短い方がいいです。

ExplorerのアドレスバーALT+Dで

Win+Rなどいりません
https://qiita.com/Q11Q/items/b9fe207ba2da3558048b
D:\ff.vbs "tenki.jp"
D:\ff.vbs "明日の天気"
D:\ff.vbs "about:blank"
D:\ff.vbs

Dim objShell
Dim var,url,buf,buf2
set var = Wscript.Arguments
if var.count>0 then
IF Lcase(var(0))=  "about:blank" then
buf =  """C:\Program Files (x86)\Mozilla Firefox\firefox.exe"""
Set objShell = CreateObject("WScript.Shell")
objShell.Run buf , vbNormalFocus, False
ElseIf blURL(var(0)) = True Then
Wscript.echo "line10"
url =chr(34) & chr(34) & var(0)  & chr(34)  & chr(34) 
buf =  """C:\Program Files (x86)\Mozilla Firefox\firefox.exe"" " & url  '& " Sid"
Set objShell = CreateObject("WScript.Shell")
objShell.Run buf , vbNormalFocus, False
ElseIF blURL(var(0)) = False Then
buf2=fnURLENCODE2013(var(0))
buf2 = "www.google.com/search?q=" & buf2 & "&start=0"
url =chr(34) & chr(34) & buf2  & chr(34)  & chr(34) 
buf =  """C:\Program Files (x86)\Mozilla Firefox\firefox.exe"" " & url  '& " Sid"
Set objShell = CreateObject("WScript.Shell")
objShell.Run buf , vbNormalFocus, False
End if
End if
Set objShell = Nothing
Wscript.Quit

完成したコード

Dim objShell
Dim var,url,buf,buf2
set var = Wscript.Arguments
if var.count>0 then
IF Lcase(var(0))=  "about:blank" then
buf =  """C:\Program Files (x86)\Mozilla Firefox\firefox.exe"""
Set objShell = CreateObject("WScript.Shell")
objShell.Run buf , vbNormalFocus, False
ElseIf blURL(var(0)) = True Then
Wscript.echo "line10"
url =chr(34) & chr(34) & var(0)  & chr(34)  & chr(34) 
buf =  """C:\Program Files (x86)\Mozilla Firefox\firefox.exe"" " & url  '& " Sid"
Set objShell = CreateObject("WScript.Shell")
objShell.Run buf , vbNormalFocus, False
ElseIF blURL(var(0)) = False Then
buf2=fnURLENCODE2013(var(0))
buf2 = "www.google.com/search?q=" & buf2 & "&start=0"
url =chr(34) & chr(34) & buf2  & chr(34)  & chr(34) 
buf =  """C:\Program Files (x86)\Mozilla Firefox\firefox.exe"" " & url  '& " Sid"
Set objShell = CreateObject("WScript.Shell")
objShell.Run buf , vbNormalFocus, False
End if
End if
Set objShell = Nothing
Wscript.Quit

Function blURL(buf)
Dim Reg : Set Reg  =  CreateObject("VBScript.RegExp")
DIm strPtn
strPtn = "^(https*|ftp)://[-_!~';:@&=,%#/a-zA-Z0-9\$\*\+\?\.\(\)]+$"
With Reg
.Global=true
.Multiline=false
.IgnoreCase = True
.Pattern =strPtn
If .Test(buf) =True Then blURL=True :exit function
'[2007年02月07日 URLにマッチする正規表現（VB）](http://d.hatena.ne.jp/kdoi/20070207/1170861517)
strPtn ="https?://(([-_.!~*'()a-zA-Z0-9;:&=+$,]|%[0-9A-Fa-f][0-9A-Fa-f])*@)?((([a-zA-Z0-9]|" _ 
& "[a-zA-Z0-9][-a-zA-Z0-9]*[a-zA-Z0-9])\.)*([a-zA-Z]|[a_-zA-Z][-a-zA-Z0-9]*[a-zA-Z0-9])\.?|" _ 
& "[0-9]+\.[0-9]+\.[0-9]+\.[0-9]+)(:[0-9]*)?(/([-_.!~*'()a-zA-Z0-9:@&=+$,]|" _ 
& "%[0-9A-Fa-f][0-9A-Fa-f]_)*(;([-_.!~*'()a-zA-Z0-9:@&=+$,]|%[0-9A-Fa-f][0-9A-Fa-f])*)*(/([-_.!~*'()a-zA-Z0-9:@&=+$,]|" _ 
& "%[0-9A-Fa-f][0-9A-Fa-f])*(;([-_.!~*'()a-zA-_Z0-9:@&=+$,]|%[0-9A-Fa-f][0-9A-Fa-f])*)*)*)?(\?([-_.!~*'()a-zA-Z0-9;/?:@&=+$,]|%[0-9A-Fa-f][0-9A-Fa-f])*)?(#([-_.!~*'()a-zA-Z0-9;/?:@&_=+$,]|%[0-9A-Fa-f][0-9A-Fa-f])*)?"
.Pattern =strPtn
If .Test(buf) =True Then blURL=True :exit function
strPtn="^[0-9A-z]{3,20}\.com$|^[0-9A-z]{3,20}\.co\.jp$|^[0-9A-z]{3,20}\.jp$|^[0-9A-z]{3,20}\.go\.jp$"
.Pattern =strPtn
If .Test(buf) =True Then blURL=True : exit function
End With
blURL=False
End Function

Function fnURLENCODE2013(str)
Dim xlApp: Set xlApp = CreateObject("Excel.application")
fnURLENCODE2013 = xlApp.WorksheetFunction.EncodeURL(str)
Set xlApp = Nothing
End Function