View Mapped Drives Script

Using a previously asked question I have the following code but instead of emailing this I would like to save results to a individual text file named WhateverTheComputerNameIs.txt  stored at a given UNC path.   The code below will pull all MANUAL mapped network drives for the currently logged on user and then e-mail results.  I verified that this works.

' List Mapped Network Drives

On Error Resume Next

strComputer = "."

' Current Drive (in loop)
OneMap = ""
' All Mapped Drives
AllMap = ""

Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")

Set colItems = objWMIService.ExecQuery("Select * from Win32_LogicalDisk WHERE DriveType = 4")

For Each objItem in colItems
    OneMap = objItem.DeviceID & " = " & objItem.ProviderName
    AllMap = AllMap & vbCrLf & OneMap  
		OneMap = ""
Next

' OneMap is populated with all mapped drives. Prepare e-mail

Dim ToAddress
Dim MessageSubject
Dim ol, ns, newMail


ToAddress = "BLABLABLA.com"   ' change this...
MessageSubject = "Drive Mappings"

Set ol = WScript.CreateObject("Outlook.Application")
Set ns = ol.getNamespace("MAPI")
ns.logon "","",true,false
Set newMail = ol.CreateItem(olMailItem)
newMail.Subject = MessageSubject
newMail.Body = AllMap & vbCrLf

' validate the recipient, just in case...
Set myRecipient = ns.CreateRecipient(ToAddress)
myRecipient.Resolve
If Not myRecipient.Resolved Then
   MsgBox "unknown recipient"
Else
   newMail.Recipients.Add(myRecipient)
   newMail.Send
End If

Set ol = Nothing

Open in new window

ITNCAsked:
Who is Participating?
 
Steve KnightConnect With a Mentor IT ConsultancyCommented:
If you want to while you are at it different people could be logging on then this would make

c:\utils\computername-username.txt

Just change the strSavePath bit as needed but make sure there is \ on the end, i.e.

\\server\hiddenshare$\info\

Steve

' List Mapped Network Drives

On Error Resume Next

strSavePath="c:\utils\"

set oWsh = WScript.CreateObject("WScript.Shell")
set oWshSysEnv = oWsh.Environment("PROCESS")
strComputerName = oWshSysEnv("COMPUTERNAME")
strUserName=oWshSysEnv("USERNAME")


' All Mapped Drives
AllMap = "User: " & StrUserName

Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")

Set colItems = objWMIService.ExecQuery("Select * from Win32_LogicalDisk WHERE DriveType = 4")

For Each objItem in colItems
    AllMap = AllMap & vbCRLf & objItem.DeviceID & " = " & objItem.ProviderName
Next


Set objFile = createobject("scripting.filesystemobject")
	Set FileTemp = objFile.createtextFile(strSavePath & strComputerName & "-" & strUserName & ".TXT")
		FileTemp.WriteLine Allmap
	FileTemp.close
Set objFile = Nothing

Open in new window

0
 
Steve KnightIT ConsultancyCommented:
You can soon write to a text file in a path of your choosing:

' List Mapped Network Drives

On Error Resume Next

strSavePath="c:\utils\"

set oWsh = WScript.CreateObject("WScript.Shell")
set oWshSysEnv = oWsh.Environment("PROCESS")
strComputerName = oWshSysEnv("COMPUTERNAME")


' All Mapped Drives
AllMap = ""

Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")

Set colItems = objWMIService.ExecQuery("Select * from Win32_LogicalDisk WHERE DriveType = 4")

For Each objItem in colItems
    AllMap = AllMap & objItem.DeviceID & " = " & objItem.ProviderName & vbCrLf 
Next


Set objFile = createobject("scripting.filesystemobject")
	Set FileTemp = objFile.createtextFile(strSavePath & strComputerName & ".TXT")
		FileTemp.WriteLine Allmap
	FileTemp.close
Set objFile = Nothing

Open in new window

0
 
Bill PrewCommented:
Wasn't sure if you still wanted the email, so left it in but added a little modularity with subroutines and functions to make it easy if you didn't still want it.  Let me know if you have questions.

' List Mapped Network Drives
Const ComputerName = "."
Const ReportFolder = "\\server\share\folder\"
Const EmailTo

On Error Resume Next

strAllMap = GetMappedDrives(ComputerName)
WriteReport ReportFolder, strAllMap
SendEmail EmailTo, strAllMap

Wscript.Quit


Function GetMappedDrives(strComputer)
   GetMappedDrives = ""

   Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
   
   Set colItems = objWMIService.ExecQuery("Select * from Win32_LogicalDisk WHERE DriveType = 4")
   
   For Each objItem in colItems
       GetMappedDrives = objItem.DeviceID & " = " & objItem.ProviderName & vbCrLf & GetMappedDrives
   Next

   Set colItems = Nothing
   Set objWMIService = Nothing
End Function

Sub WriteReport(strFolder, strData)
   Const ForWriting = 2
   
   Set objFSO = CreateObject("Scripting.FileSystemObject")
   Set objShell = WScript.CreateObject( "WScript.Shell" )

   strFileName = objShell.ExpandEnvironmentStrings(ReportFolder & "%COMPUTERNAME%" & ".txt")
   Set objFile = objFSO.OpenTextFile(strFileName, ForWriting, True)

   objFile.Write strData
   objFile.Close

   Set objFile = Nothing
   Set objFSO = Nothing
   Set objShell = Nothing
Sub

Sub SendEmail(strToAddress, strBody)
   Set ol = WScript.CreateObject("Outlook.Application")
   Set ns = ol.getNamespace("MAPI")
   ns.logon "", "", true, false
   Set newMail = ol.CreateItem(olMailItem)
   newMail.Subject = "Drive Mappings"
   newMail.Body = strBody
   
   ' validate the recipient, just in case...
   Set myRecipient = ns.CreateRecipient(strToAddress)
   myRecipient.Resolve
   If Not myRecipient.Resolved Then
      MsgBox "unknown recipient: " & strToAddress
   Else
      newMail.Recipients.Add(myRecipient)
      newMail.Send
   End If
   
   Set myRecipient = Nothing
   Set newMail = Nothing
   Set ns = Nothing
   Set ol = Nothing
End Sub

Open in new window

~bp
0
Cloud Class® Course: C++ 11 Fundamentals

This course will introduce you to C++ 11 and teach you about syntax fundamentals.

 
ITNCAuthor Commented:
I'm looking over these now.  I will let you know how they work soon! Thanks so much for the help.
0
 
ITNCAuthor Commented:
Works PERFECT!  Thanks!!!
0
 
Steve KnightIT ConsultancyCommented:
Glad to help, Bill's offering is certainly much neater, mine was quickly bodged onto your existing script with a bit of redundant parts removed, but as long as you are happy!

Steve
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.