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-pro...-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 "