【VBS】ネットワークドライブに再接続できませんでしたなんて言わないよ絶対

2017年12月19日2020年5月24日NAS,プログラムVBS,ネットワークドライブ

ネットワークドライブを張っていて、PC起動時に「ネットワークドライブに再接続できませんでした」のエラーをVBSで回避する。
画面の右下にピョッと出てくるアレ。

1. 回避策
- 1.1. コード。
- 1.2. エラー
2. これも回避する
- 2.1. コード
- 2.2. 保存
3. 資格情報の保存

回避策

%APPDATA%\Microsoft\Windows\Start Menu\Programs

上記のフォルダに、[適当なファイル名].vbsを作成。
（「NetworkDrive.vbs」とか）
下記コードをコピペして保存。

コード。

WScript.sleep 2000
Set objNetwork = CreateObject("WScript.Network")
objNetWork.MapNetworkDrive "Z:", "\\192.168.1.10\NAS"

でも、NASの電源を落としていたりすると、エラーが出てしまう。

エラー

これも回避する

ということで、アレコレなんやかんや調べていじった結果。

コード

1.pingが通って
2.ドライブレターが使用されていなければ
3.ネットワークドライブの割り当て

という流れ。待機時間はお好みで。
※USRS_NAMEとUSER_PASSは、NASに接続するためのユーザー名とパスワード。
このファイルに書くよりも、資格情報(後述)に記憶したほうがよさそう。

' --------------------------------
' 定数
' --------------------------------
Const SERVER_IP = "192.168.1.10" ' NASのIPアドレス
Const DRIVE_LETTER = "Z:"        ' ネットワークドライブのドライブレター
Const SHARED_FOLDER = "NAS"      ' 共有フォルダ名
Const USER_NAME = "user"         ' アクセスするユーザー名
Const USER_PASS = "password"     ' ユーザーパスワード
Const WAIT_TIME = 2000           ' pingを打つまでの待機時間(ミリ秒)

' -------------------------------------
' ネットワークドライブの割り当て
' -------------------------------------
if fncPing(SERVER_IP) Then
  Dim connectFolder: connectFolder = "\\" + Server_IP + "\" + SHARED_FOLDER
  Set objFSO = CreateObject("Scripting.FileSystemObject")

' ドライブレターが使用されているか
  if Not objFSO.DriveExists(DRIVE_LETTER) Then
    Set objNetwork = CreateObject("WScript.Network")
    objNetWork.MapNetworkDrive DRIVE_LETTER, connectFolder, false, USER_NAME, USER_PASS
    Set objNetwork = Nothing
  Else
    MsgBox "「" + DRIVE_LETTER + "」" + " はすでに使用されています",,"エラー"
  End if
Else
  MsgBox "「" + SERVER_IP + "」" + "から応答がありません",,"エラー"
End if

' -------------------------------------
' pingが返ってくるか
' -------------------------------------
Function fncPing(host)
  WScript.sleep WAIT_TIME
  Set objWMI = GetObject("winmgmts:\\.\root\cimv2")
  Set colItems = objWMI.ExecQuery("select * from Win32_PingStatus where address ='" & host & "'")

  For Each objItem In colItems
    If objItem.StatusCode = 0 Then
      fncPing = True
    Else
      fncPing = False
    End If
  Next

Set objItem = Nothing
Set colItems = Nothing
Set objWMI = Nothing
End Function