Solved

View Mapped Drives Script

Posted on 2013-01-24
6
287 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 52

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

Want to promote your upcoming event?

Are you going to an event? Are you going to be exhibiting at a tradeshow? Talking at a conference? Using a promotional banner in your email signature ensures that your organization’s most important contacts stay in the know and can potentially spread the word about the event.

Question has a verified solution.

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

This is an article about Leadership and accepting and adapting to new challenges. It focuses mostly on upgrading to Windows 10.
Join Greg Farro and Ethan Banks from Packet Pushers (http://packetpushers.net/podcast/podcasts/pq-show-93-smart-network-monitoring-paessler-sponsored/) and Greg Ross from Paessler (https://www.paessler.com/prtg) for a discussion about smart network …
Windows 8 came with a dramatically different user interface known as Metro. Notably missing from that interface was a Start button and Start Menu. Microsoft responded to negative user feedback of the Metro interface, bringing back the Start button a…
With the advent of Windows 10, Microsoft is pushing a Get Windows 10 icon into the notification area (system tray) of qualifying computers. There are many reasons for wanting to remove this icon. This two-part Experts Exchange video Micro Tutorial s…

920 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

Need Help in Real-Time?

Connect with top rated Experts

15 Experts available now in Live!

Get 1:1 Help Now