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

Popular posts from this blog

Revit area plans adding new types and references (Gross and rentable)

Powerpoint countdown and current time in slides VBA

Revit 2019 and up tab colorizer