Solved

View Mapped Drives Script

Posted on 2013-01-24
6
295 Views
Last Modified: 2013-01-25
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

0
Comment
Question by:ITNC
  • 3
  • 2
6 Comments
 
LVL 43

Expert Comment

by:Steve Knight
ID: 38818546
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
 
LVL 43

Accepted Solution

by:
Steve Knight earned 500 total points
ID: 38818560
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
 
LVL 53

Expert Comment

by:Bill Prew
ID: 38818583
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
3 Use Cases for Connected Systems

Our Dev teams are like yours. They’re continually cranking out code for new features/bugs fixes, testing, deploying, testing some more, responding to production monitoring events and more. It’s complex. So, we thought you’d like to see what’s working for us.

 

Author Comment

by:ITNC
ID: 38819408
I'm looking over these now.  I will let you know how they work soon! Thanks so much for the help.
0
 

Author Closing Comment

by:ITNC
ID: 38819703
Works PERFECT!  Thanks!!!
0
 
LVL 43

Expert Comment

by:Steve Knight
ID: 38819964
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

Featured Post

Master Your Team's Linux and Cloud Stack

Come see why top tech companies like Mailchimp and Media Temple use Linux Academy to build their employee training programs.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

When you try to extract and to view the contents of a Microsoft Update Standalone Package (MSU) for Windows Vista, you cannot extract the files from the MSU. Here we are going to explain how to extract those hotfix details without using any third pa…
An article on effective troubleshooting
The viewer will learn the basics of jQuery, including how to invoke it on a web page. Reference your jQuery libraries: (CODE) Include your new external js/jQuery file: (CODE) Write your first lines of code to setup your site for jQuery.: (CODE)
In this seventh video of the Xpdf series, we discuss and demonstrate the PDFfonts utility, which lists all the fonts used in a PDF file. It does this via a command line interface, making it suitable for use in programs, scripts, batch files — any pl…

777 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question