How do I call this VBscript in VBA

Macro_Nerd99

Board Regular
Joined
Nov 13, 2021
Messages
61
Office Version
  1. 365
Almost every time I restart my computer, I have to click on this "Map Network Drives" application before I can run any VBA macros(without Runtime errors).
I've been trying to find a way to automatically map network drives every time I open a specific workbook, to prevent those runtime errors.
Recently, I found out that the "map network drives" application is a VBscript(the code below).
Can I automatically run this vbscript in the "Workbook_Open()" Event?

I tried this code but wasn't sure how to tell if it works:
Shell "cscript C:\Program Files (x86)\DriveMappings\RAmapdrives-v2.vbs", vbNormalFocus

Thanks



VBA Code:
[CODE=vba]' **********************************************************************
'
' RAmapdrives-v1.vbs (VBScript)
' Windows XP Login Script
'
'
' Version:    1
'
' This Script maps drives based on Security Groups.
' The Security Groups, Drive Letters, and Share Names are extracted from
' a file located on the NetLogon share. (Currently; DriveMapControl = "DriveMapControl1.txt")
'

On Error Resume Next

StartTime = Timer()

'***** Create Objects
Set Fso = CreateObject("Scripting.FileSystemObject")
Set WshShell = CreateObject("WScript.Shell")
Set EnvVar = WshShell.Environment("PROCESS")
Set WshNetwork = WScript.CreateObject("WScript.Network")
Set objUser = CreateObject("ADSystemInfo")


'***** Input File containing Security Groups, Drive Letters, and Share Names
DriveMapControl = "DriveMapControl1.txt"
strDialDeny = "DriveMapDialIn.deny"


'***** Determine Logon Server from Environment Variable (%LOGONSERVER%)
LogonServer = EnvVar.Item("LogonServer")

If Err.Number <> 0 Then ' Create an Event Log entry if %LOGONSERVER% is unsuccessful
    WshShell.LogEvent 1, Err.Number & " " & Err.Description & ": " & "Error with LogonServer"
    Err.Clear
End If


'*************************************************


'***** Get User Information from LDAP
Set CurrentUser = GetObject("LDAP://" & objUser.UserName)
If Err.Number <> 0 Then ' Create an Event Log entry if LDAP is unsuccessful
    WshShell.LogEvent 1, Err.Number & ": " & "Error with GetObject(""LDAP://"" & objUser.UserName)"
    Err.Clear
End If

'***** Get User's Group Membership  ***********
' compile list of groups that user is member of
strMemberOf = ""
for each mymo in CurrentUser.MemberOf
  strMemberOf = strMemberOf & lcase (split (split(mymo,",")(0) ,"=") (1)) & ","  ' add comma for recognition
next
'**********************************************
     
     
If Err.Number <> 0 Then ' Create an Event Log entry if Group Membership is unsuccessful
    WshShell.LogEvent 1, Err.Number & " " & Err.Description & ": " & "Error with strMemberOf"
    Err.Clear
End If


'***** Reset variables
SuccessLogEntry = ""
ConflictLogEntry = ""
MapErrorLogEntry = ""
TimeElapsed = ""
GroupMembership = ""
GroupCount = 0

If Fso.FileExists(LogonServer & "\netlogon\" & DriveMapControl) Then ' Verify input file exists
  Set GrpList = Fso.OpenTextFile(LogonServer & "\netlogon\" & DriveMapControl)
  arrGroup = Split(GrpList.Readall,vbcrlf) ' Create an Array
  GrpList.close

'******************* Main Loop ******************

'  for i = 0 to UBound(arrGroup)
  for each MapLine in arrGroup
'    MapLine = arrGroup(i)

    strGroup = split (MapLine,",")(0)
    strDriveLetter = split (MapLine,",")(1)
    strShare = split (MapLine,",")(2)
   
    If Instr(strMemberOf, strGroup & ",") Then ' added comma to insure recognition
        If LCase(Fso.DriveExists(strDriveLetter)) Then
            '***** Call the subroutine to append drive mapping conflicts
            Conflict
            '***** Disconnect conflicting drives
'         Wscript.Echo "disconnect " & strDriveLetter
            WshNetwork.RemoveNetworkDrive strDriveLetter, True, True
            If Err.Number <> 0 Then
                WshShell.LogEvent 1, Err.Number & " " & Err.Description
                Err.Clear
            End If
        End If
        '***** Map Network Drives
'      Wscript.Echo "connect " & strDriveLetter & " -> " & strShare
        WshNetwork.MapNetworkDrive strDriveLetter, strShare
        If Err.Number <> 0 Then
            '***** Call the subroutine to append any errors
            MapError
            Err.Clear
        Else
            '***** Call the subroutine to append Successful drive mappings
            Success
        End If
    End If
  Next
Else
    '***** Log error if input file not found (on the Logon Server)
    WshShell.LogEvent 1, DriveMapControl & " file not found"
End If

'******************* Log and Clean Up ******************

' Log Drive Map Errors and Additional Info
If Not Len(MapErrorLogEntry) = 0 Then
    arrMemberListRDN = Split(strMemberOf, " cn=")

    For Each MemberListRDN in arrMemberListRDN
        arrGroupMembership = Split(MemberListRDN, ",")
        GroupMembership = GroupMembership & arrGroupMembership(0) & VbCrLf
        GroupCount = GroupCount + 1
    Next
   
    WshShell.LogEvent 1, "Drive Map Errors:" & VbCrLf & VbCrLf & MapErrorLogEntry & VbCrLf _
    & "User Info:" & VbCrLf & VbCrLf & objUser.UserName & VbCrLf & VbCrLf _
    & "Site:  " & objUser.SiteName & VbCrLf & VbCrLf _
    & "Computer:  " & VbCrLf & VbCrLf & objUser.ComputerName & VbCrLf & VbCrLf _
    & "Group Count:" & VbTab & GroupCount & VbCrLf & VbCrLf _
    & "User's Current Groups:" & VbCrLf & VbCrLf & GroupMembership
   
End If

' Log Drive Mapping Conflicts
If Not Len(ConflictLogEntry) = 0 Then
    WshShell.LogEvent 2, "Drive Mapping Conflict Detected for:" & VbCrLf & VbCrLf _
    & objUser.UserName & VbCrLf & VbCrLf _
    & "Following Drive(s) have been Disconnected:" & VbCrLf & ConflictLogEntry
End If

' Log Successful Mapping Info
If Not Len(SuccessLogEntry) = 0 Then
    TimeStamp
   WshShell.LogEvent 0, "Time Elapsed: " & TimeElapsed & " ms" & VbCrLf & VbCrLf _
    & "Successfully Mapped:" & VbCrLf & VbCrLf & SuccessLogEntry & VbCrLf _
    & "User Info:  " & objUser.UserName & VbCrLf & VbCrLf _
    & "LogonServer:" & VbTab & LogonServer
End If

'TimeStamp
StartTime = ""
Wscript.Quit
'******************* DONE ******************


'*******************Error Subroutines******************
Sub MapError
MapErrorLogEntry = MapErrorLogEntry & Err.Number & " " & Err.Description & " " & " " & Err.Source & " " _
            & strDriveLetter & " " & strShare & VbCrLf
End Sub
'*******************Conflict Subroutine******************
Sub Conflict
ConflictLogEntry = ConflictLogEntry & strDriveLetter & VbTab & fso.GetDrive(strDriveLetter).sharename & VbCrLf
End Sub
'*******************Success Subroutine******************
Sub Success
SuccessLogEntry = SuccessLogEntry & strDriveLetter & " " & strShare & VbCrLf
End Sub

'*******************Time Stamp Subroutine******************
Sub TimeStamp
EndTime = Timer()
TimeElapsed = (EndTime - StartTime) * 1000
'Wscript.echo "Time Elapsed: " & TimeElapsed
'WshShell.LogEvent 0,"Time Elapsed: " & TimeElapsed & " ms" & VbCrLf
End Sub
[/CODE]
 

Attachments

  • mnd_1.JPG
    mnd_1.JPG
    61.1 KB · Views: 11

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.
Isn't running the script at Windows startup/ login a better solution?
 
Upvote 0
Isn't running the script at Windows startup/ login a better solution?
No, if that was the case, I wouldn't be asking this question. everyone that uses my program doesn't always know to map first. And when they don't, it can cause runtime errors when the code refers to directories. I wanted to either call this script or if you have an alternate solution on how to map network drives in VBA, please let me know.
 
Upvote 0

Forum statistics

Threads
1,215,473
Messages
6,125,018
Members
449,203
Latest member
tungnmqn90

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top