Temp map dropped folder to x VBS
Option Explicit
Main
Sub Main()
Const TempDrive = "Z:"
Dim fp ''file path of target folder
Dim UNC_FP ''Expanded UNC FP
Dim FSO ''As FileSystemObject
Dim oFolderInfo ''As Folder
Dim objNetwork ''As WSHNetwork
Dim WSH ''UNKNOWN WSH EXEC
Dim oDrive ''DRIVE ENUMERATOR
Set WSH = CreateObject("Shell.Application")
Set objNetwork = CreateObject("WScript.Network")
Set FSO = CreateObject("Scripting.FileSystemObject")
''fp = "k:\Denver\Projects\2019\190566 5490 W. Center Ave. Lakewood\Record Sets"
fp = wscript.Arguments.Item(0)
Set oFolderInfo = FSO.GetFolder(fp)
If oFolderInfo.Drive.DriveType = 2 Then
MsgBox "Cannot map fixed drive " & oFolderInfo.Drive.DriveLetter, vbCritical, "Error"
Exit Sub
End If
For Each oDrive In FSO.Drives
If LCase(Left(oDrive.Path, 1)) = LCase(Left(TempDrive, 1)) Then
If MsgBox("Please close all open folders to the " & TempDrive & " drive." & vbCr & vbCr & "If this is not a temporary mapped drive click CANCEL now.", vbOKCancel + vbInformation, "This will remove the map to " & TempDrive) <> vbOK Then Exit Sub
objNetwork.RemoveNetworkDrive Left(TempDrive, 2), "True", "True"
If FSO.DriveExists(Left(TempDrive, 2)) Then
MsgBox "Drive failed to delete- please close all associated folders with drive " & TempDrive, vbExclamation + vbOKOnly, "Warning- no map - exiting"
'wscript.quit
End If
Exit For
End If
Next
UNC_FP = oFolderInfo.Drive.ShareName & Right(oFolderInfo.Path, Len(oFolderInfo.Path) - 2)
objNetwork.MapNetworkDrive TempDrive, UNC_FP, "True"
If FSO.DriveExists(Left(TempDrive, 2)) Then
MsgBox "Success mapping temporary " & TempDrive & " --To-- " & vbCr & UNC_FP & vbcr & vbcr & "Opening drive on OK", vbInformation, "Success!"
WSH.Open TempDrive
End If
End Sub
'wscript.quit
Comments
Post a Comment