どこかのマシンにぶら下がっている共有を特定のドライブにマップするVBScript

USBハードディスクを複数のPCで共有しているときに、どのマシンからでも同じドライブレターで共有をマップできるツールを VBScript で書いてみました。


USBハードディスクが \\pc1\共有 もしくは \\pc2\共有 のどちらかとして共有されるシチュエーションを想定し、 \\pc1 もしくは \\pc2 のどちらかに共有が見つかればドライブをマップします。この際、目的のドライブレターに他のネットワーク共有をマップされていたら、その共有は切断した上でマップしなおします。


利用する場合は、特に DoMount() をニーズにあわせて書き直してください。正直なところエラーチェックやテストは不十分です。VBScript自体、ここ数年間で2つしか作ったことがないので、中身にあまり期待はしないでください...

Option Explicit
'On Error Resume Next

If DoMount Then
 WScript.Echo "フォルダを S: にマウントしました。"
Else
 WScript.Echo "フォルダをマウントできなかったようです..."
End If

Function DoMount
 If TryToConnect("S:", "\\pc1\共有") Then
  DoMount = True
 ElseIf TryToConnect("S:", "\\pc2\共有") Then
  DoMount = True
 Else
         DoMount = False
 End if
End Function

Function IsShareExist(ShareName)
 Dim objFSO

 Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
 IsShareExist = objFSO.FolderExists(ShareName)

End Function

Function TryToConnect(Drive, ShareName)
 TryToConnect = False

 If IsShareExist(ShareName) Then
  TryToConnect = DoMapNetwork(Drive, ShareName)
 End If
End Function

Function DoMapNetwork(strDrive, strPubFolder)
 Dim objWshNetwork
 Set objWshNetwork = WScript.CreateObject("WScript.Network")
 Dim CurrentMapped

 DoMapNetwork = False
 CurrentMapped = GetMapNetwork(strDrive)
 If CurrentMapped = strPubFolder Then
  DoMapNetwork = True
  Exit Function
 ElseIf CurrentMapped <> "" Then
  objWshNetwork.RemoveNetworkDrive strDrive, True
 End If

 objWshNetwork.MapNetworkDrive strDrive, strPubFolder
 DoMapNetwork = (Err.Number = 0)
End Function

Function GetMapNetwork(strDrive)
 Dim WshNetwork, oDrives, i
 Set WshNetwork = WScript.CreateObject("WScript.Network")
 Set oDrives = WshNetwork.EnumNetworkDrives

 GetMapNetwork = ""
 For i = 0 to oDrives.Count - 1 Step 2
  If strDrive = oDrives.Item(i) Then
   GetMapNetwork = oDrives.Item(i + 1)
  End If
 Next
End Function