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として正しいかどうかを正規表現を使って判断する方法](http://blog.mamohacy.com/entry/2011/12/09/165725)
[[digital]URLにマッチする正規表現](http://d.hatena.ne.jp/kdoi/20070207/1170861517)
と
###わがままパターン
3文字から20字まで
英数字ドットコム google.com
英数字ドットJp tenki.jp
英数字ドットcoドットjp yahoo.co.jp
英数字ドットgoドットjp  jma.go.jp
の三パターンをURLとするMyPatternでどれか一つに当たったらURLと判定します。

```vb
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で呼び出す基本
https://oshiete1.nifty.com/qa8611462.html

###新たなタブが開かれる仕様に変更
```visualbasic
objShell.Run """C:\Program Files\Mozilla Firefox\firefox.exe"" ""http://★★★/" & Sid & """", vbNormalFocus, False
```
のsidっているのかな...たしかにないと、既存のFirefoxに新たなタブとして開かれます。Sidを追加すると新たにFirefoxが立ち上がり、URLとSid/というページができます。まだバグっているのかも。
とりあえず新しいタブが追加される仕様です。

###Googleの検索文字列の参考
[WebクエリでGoogleの検索結果を取得する](http://yumem.cocolog-nifty.com/excelvba/2012/03/webgoogle-c0f1.html)

###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


```visualbasic
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
```

#完成したコード

```visualbasic
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
```