VBA（VBScript）のInputBoxで入力したアドレスがなかったら自動的に別のアドレスで表示したい

例えば C:\a を入力して、フォルダがなければ自動的に語尾にbの文字列を足して
C:\ab のフォルダを表示するには下記のスクリプトをどのように改良すればよいのでしょうか？

Dim s
s = InputBox("アドレスを入力")
With CreateObject("InternetExplorer.Application")
.Visible = True
.Navigate s
End With

ご存知の方がおられましたらご回答をよろしくお願いします。

No.1 ベストアンサー 回答者： hige_082 回答日時： 2008/06/07 22:27

下記が参考になればと思います

http://www.asahi-net.or.jp/~ef2o-inue/vba_o/sub0 …

フォルダの存在を先にしておき、エクスプローラへ値を渡した方が良いのではと思います

参考URL：http://www.asahi-net.or.jp/~ef2o-inue/vba_o/sub0 …

No.3 回答者： Wendy02 回答日時： 2008/06/08 12:41

こんにちは。

それは、前回の話の延長だと思いますが、ちょっとイメージが違ってくると思います。
あえて前回の回答で、そのExcelの枠を取ってしまいましたから、もう、ここカテゴリの範囲とは直接関係なくなってしまっているようです。

それと、Internet Explorer にフォルダのアドレスを渡してもよいのですが、直接、Explorer に渡す方法を考えてみました。前回の回答に対して、どう結びつけるのかは分かりませんし、こちらの書いた考え方が、返って意味が違うものかもしれませんが、ある程度の標準的な内容のレベルは、ご質問者の理解とは別に、維持したいと思います。ただし、Excelオブジェクトを使うのは、私はお勧めしません。

Sub や　Function は、サブルーチン・プロシージャとして個別に利用できますから、引数だけ与えてあげればよいです。

意味もなく単語を付け足したところで、それでフォルダを開けられず、そのまま終了では、プログラムとしては意味がありません。フォルダのある・なしだけなら、以下のユーザー定義関数だけを抜き出して適当に利用してください。ユーザー定義関数の引数に入れれば、フォルダがあれば、True、なければ、False が返ります。

なお、実際に、付け足す文字が１個というのはありえませんから、複数を加えるようにしました。最初にヒットしたもので開きます。ヒットしなければ、その親フォルダから、ダイアログで開いて、目視で選択します。なお、sSEPARATOR は、\ にしています。通常は問題ないと思いますが、違うようなら、その部分を書き換えてください。


'付け足す単語
Const ADD ="b"

入力例：
Const ADD ="b,c,d,e"

のようにすればよいです。

以下には、テキスト・ドキュメントで取り出せば、タブコードは入っていますが、見かけ上は、ベタのままです。ベタのほうがファイル量は減ります。以下で、だいたい、タブ入りで1.20 Kbになります。限界量が分かりませんから、これ以上小さくするなら、DirCheck()関数だけを使って調べるだけでもよいかもしれません。なお、今回のコードで変数/定数の、ADDs と sSEPARATOR は残しておいたほうが良いと思います。他の変数は削除しました。

名前は適当に、拡張子は、.vbs　です。
'------------------------------
Dim ADDs
'セパレータ
Const sSEPARATOR ="\"
'付け足す単語：複数の場合は　ADD="b,c,d,e"
Const ADD ="pex"
ADDs = Split(ADD,",")
s = InputBox("アドレスを入力")
Call GotoWeb(s)

Sub GotoWeb(s)
If s ="" Then Exit Sub
flg =False
'入力値をチェック
If Instr(s,sSEPARATOR)>0 Then
If Right(s,1)= sSEPARATOR Then s =Mid(s,1,Len(s)-1)
inFlg =True
Else
inFlg =False
End If

If InFlg Then
If DirCheck(s) =False Then
For Each a in ADDs
t = s & a
If DirCheck(t) =True Then
s =t
Flg = True
Exit For
End If
Next
Else
Flg =True
End If
End If

If Flg =False And InFlg Then
t = Mid(s,1, InStrRev(s, sSEPARATOR))
Set f= CreateObject("Shell.Application").BrowseForFolder(0,"フォルダを選んでください",&H8, t)
If f Is Nothing Then
Exit Sub
Else
s = f.Items.Item.Path
End If
End If

If InFlg Then

CreateObject("WScript.Shell").Run "explorer.exe " & s

Else
With CreateObject("InternetExplorer.Application")
.Visible = True
.Navigate s
End With
End If

End Sub

Function DirCheck(s)
Set objFS =CreateObject("Scripting.FileSystemObject")
If objFS.FolderExists(s) Then
DirCheck =True
Else
DirCheck =False
End iF
End Function

'----------------------------------------

No.2 回答者： mitarashi 回答日時： 2008/06/07 23:16

フォルダーの閲覧なら、A No.1の方の言われる通り、別の方法を取った方がベターと思いますが、後学のためにやってみました。

VBScriptは詳しくないので、VBAのコードです。参考URLの相当下の方に、リンク切れの判別方法があります。ご参考まで。
Sub test()
Dim s
Dim returnMessage As String
Dim retryFlag As Boolean

s = "c:\a"
With CreateObject("InternetExplorer.Application")
.Visible = True
.Navigate s
While .readystate <> 4
While .busy = True
DoEvents
Wend
Wend
On Error Resume Next '正常に開けると次がエラーになるので誤魔化し
returnMessage = .Document.body.innerText
If InStr(returnMessage, "ページを表示できません") Then
s = "c:\ab"
retryFlag = True
.Quit
End If
End With
If retryFlag Then
With CreateObject("InternetExplorer.Application")
.Visible = True
.Navigate s
End With
End If
End Sub

参考URL：http://hanatyan.sakura.ne.jp/logbbs/wforum.cgi?m …