asked on

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

Steve Knight

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

ASKER CERTIFIED SOLUTION

Steve Knight

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Bill Prew

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

ITNC

ASKER

I'm looking over these now. I will let you know how they work soon! Thanks so much for the help.

ITNC

ASKER

Works PERFECT! Thanks!!!

Steve Knight

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