I have the below batch file that remaps an existing Y: drive remote shared folder to another freely available drive letter, and then disconnects Y: drive and remaps it to my chosen remote folder or local folder.
But i don't know how to convert this batch code into a VBA function i.e. similar to below shown function. I am mainly having problems with the double-quotes in `sCMD` string.
Any help would be most appreciated.
What the batch commands do is :
See if the concerned Drive e.g. Y: is available or not.
If in use, assign Y:'s network path to the next freely available drive.
Disconnect (delete) Y:
Assign Y: to concerned Directory (Local or Remote).
So need the `sCMD` properly double-quoted inorder to make it work!
Sub TestDriveMapping()
MapBasePathToDrive "\\xx.xx.xx.xx\SomeFolder", "Y:", True
End Sub
Here is the function:
Function MapBasePathToDrive(FullDirectory As String, strDrive As String, blnReadAttr As Boolean) As String
Dim objShell As Object
Dim sCmd$, sDrv$
Dim WaitOnReturn As Boolean: WaitOnReturn = True
Dim WindowStyle As Integer: WindowStyle = 0
Dim i&, lngErr&
' remove backslash for `NET USE` dos command to work
If Right(FullDirectory, 1) = "\" Then FullDirectory = Left(FullDirectory, Len(FullDirectory) - 1)
sDrv = Left(FullDirectory, 2)
' check if Directory Local or Remote
If Left(FullDirectory, 2) <> "\\" And sDrv Like "?:" Then
FullDirectory = "\\localhost\" & Left(sDrv, 1) & "$" & Right(FullDirectory, Len(FullDirectory) - 2)
End If
' prefix & suffix directory with double-quotes
FullDirectory = Chr(34) & FullDirectory & Chr(34)
Set objShell = CreateObject("WScript.Shell")
sCmd = ""
sCmd = "@Echo Off " & vbCrLf
sCmd = sCmd & " IF EXIST " & strDrive & " ( " & vbCrLf
sCmd = sCmd & " FOR /F ""TOKENS=1,2,3"" %%G IN ('NET USE ^|Find /I """ & strDrive & """ ^|Find ""\\""') DO ( NET USE * %%H >NUL 2>&1) " & vbCrLf
sCmd = sCmd & " NET USE " & strDrive & " /DELETE >NUL 2>&1 " & vbCrLf
sCmd = sCmd & " )" & vbCrLf
sCmd = sCmd & " NET USE " & strDrive & " " & FullDirectory & " >NUL 2>&1 "
lngErr = objShell.Run(sCmd, WindowStyle, WaitOnReturn)
Debug.Print Err.Number & "_" & Err.Description
' remove read-only attribute from Destination folder if you plan to copy files
If blnReadAttr Then
sCmd = "ATTRIB " & "-R" & " " & strDrive & "\*.*" & " " & "/S /D"
lngErr = objShell.Run(sCmd, WindowStyle, WaitOnReturn)
End If
' to refresh explorer to show newly created drive
sCmd = "%windir%\explorer.exe /n,"
lngErr = objShell.Run(sCmd & strDrive, WindowStyle, WaitOnReturn)
' add backslash to drive if absent
MapBasePathToDrive = IIf(Right(strDrive, 1) <> "\", strDrive & "\", strDrive)
End Function
And here is the actual Batch code i wrote which works. Please note there is no error handling code to handle if all free drives are exhausted. If someone can also help with that, that would be useful for everyone :
@echo off
if exist y:\ (
for /F "tokens=1,2,3" %%G in ('net use^|Find /I "Y:"^|Find "\\"') do ( net use * %%H >nul 2>&1)
net use y: /delete >nul 2>&1
)
net use y: \\xx.xx.xx.xx\SomeFolder >nul 2>&1
http://www.vbaexpress.com/forum/show...o-VBA-Function
Bookmarks