Converting DOS Commands to VBA Function

[sifar786]

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 I want to do :


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).





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



https://www.excelforum.com/excel-programming-vba-macros/1308449-converting-dos-commands-to-vba-function.html

[snb]

Drivetype 3 = 'Remote'


Sub M_snb()
With CreateObject("scripting.filesystemobject")
For Each it In .drives
MsgBox "Driveletter: " & it.driveletter & vbLf & "Drivetype: " & it.driveType & vbLf & "Sharename: " & it.ShareName & vbLf & "VolumeName: " & it.VolumeName
Next
End With
End Sub

[sifar786]

Hi @snb Thanks.

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 only need the `sCMD` properly double-quoted inorder to make it work!


P.S: If i copy the `sCMD` output (debug.print) to a text file (*.bat) and run it from command prompt, it works, but not when i want to run it from 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 "