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の検索文字列の参考
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
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
Author And Source
この問題について(FireFox VBScript Excel 2013 Later わがまま日本仕様 引数で空白 yahoo 検索 HPジャンプを使い分ける), 我々は、より多くの情報をここで見つけました https://qiita.com/Q11Q/items/307b13fb368b91a2ce91著者帰属：元の著者の情報は、元のURLに含まれています。著作権は原作者に属する。
Content is automatically searched and collected through network algorithms . If there is a violation . Please contact us . We will adjust (correct author information ,or delete content ) as soon as possible .