?
Solved

View Mapped Drives Script

Posted on 2013-01-24
6
Medium Priority
?
324 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 2000 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 59

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
What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

 

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

Free Tool: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

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

The article covers five tools all IT professionals should know about, as they up productivity by a great deal!
When you discover the power of the R programming language, you are going to wonder how you ever lived without it! Learn why the language merits a place in your programming arsenal.
This is used to tweak the memory usage for your computer, it is used for servers more so than workstations but just be careful editing registry settings as it may cause irreversible results. I hold no responsibility for anything you do to the regist…
With the power of JIRA, there's an unlimited number of ways you can customize it, use it and benefit from it. With that in mind, there's bound to be things that I wasn't able to cover in this course. With this summary we'll look at some places to go…
Suggested Courses
Course of the Month15 days, 17 hours left to enroll

850 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