Macro_Nerd99
Board Regular
- Joined
- Nov 13, 2021
- Messages
- 61
- Office Version
- 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
[/CODE]
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