jbauer22
asked on
How to check if a drive is mapped
I want a function that will check if a particular drive is currently mapped and return the drive mapping if it is or return "" if it isn't. Something I can add a Drive letter parameter to like:
Msgbox DriveMapping("K")
and get a message box that returns something like "\\odinput\psreports" if mapped or "" if not.
Msgbox DriveMapping("K")
and get a message box that returns something like "\\odinput\psreports" if mapped or "" if not.
ASKER
Want a function, please
I am not sure if i understood you:
Function IsLetterMapped(DriveLetter
If Dir$(DriveLetter & ":\*.*", vbArchive) <> "" Then
IsLetterMapped = DriveLetter & ":\"
Else
IsLetterMapped = ""
End If
End Function
Private Sub Form_Load()
MsgBox IsLetterMapped("K")
End Sub
Function IsLetterMapped(DriveLetter
If Dir$(DriveLetter & ":\*.*", vbArchive) <> "" Then
IsLetterMapped = DriveLetter & ":\"
Else
IsLetterMapped = ""
End If
End Function
Private Sub Form_Load()
MsgBox IsLetterMapped("K")
End Sub
ASKER
Richie,
If the Drive is not mapped then a Run-time error 68 will occur. I tried this same method using the Dir function. I suppose, I could use error handling to work this out. I also wanted this function to return the current drive mapping if it was found. Some string with the //Network...
If the Drive is not mapped then a Run-time error 68 will occur. I tried this same method using the Dir function. I suppose, I could use error handling to work this out. I also wanted this function to return the current drive mapping if it was found. Some string with the //Network...
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Option Explicit
Private Declare Function GetLogicalDriveStrings Lib "kernel32" _
Alias "GetLogicalDriveStringsA" _
(ByVal nBufferLength As Long, _
ByVal lpBuffer As String) As Long
Private Sub Form_Load()
Debug.Print DriveExists("D:")
End Sub
Private Function DriveExists(SDrive As String) As Boolean
Dim tmp As String
Dim nBuffersize As Long
'Call the API with a buffer size of 0.
'The call fails, and the required size
'is returned as the result.
nBuffersize = GetLogicalDriveStrings(0&,
'pad a string to hold the results
tmp = Space$(nBuffersize)
nBuffersize = Len(tmp)
'and call again
If GetLogicalDriveStrings(nBu
'if the drive letter passed is in
'the returned logical drive string,
'return True. Use vbTextCompare for
'a case-insensitive match (remembering
'that when a compare method is specified,
'the start position must also be specified.
DriveExists = InStr(1, tmp, SDrive, vbTextCompare)
End If
End Function
Private Declare Function GetLogicalDriveStrings Lib "kernel32" _
Alias "GetLogicalDriveStringsA" _
(ByVal nBufferLength As Long, _
ByVal lpBuffer As String) As Long
Private Sub Form_Load()
Debug.Print DriveExists("D:")
End Sub
Private Function DriveExists(SDrive As String) As Boolean
Dim tmp As String
Dim nBuffersize As Long
'Call the API with a buffer size of 0.
'The call fails, and the required size
'is returned as the result.
nBuffersize = GetLogicalDriveStrings(0&,
'pad a string to hold the results
tmp = Space$(nBuffersize)
nBuffersize = Len(tmp)
'and call again
If GetLogicalDriveStrings(nBu
'if the drive letter passed is in
'the returned logical drive string,
'return True. Use vbTextCompare for
'a case-insensitive match (remembering
'that when a compare method is specified,
'the start position must also be specified.
DriveExists = InStr(1, tmp, SDrive, vbTextCompare)
End If
End Function
Hi hiranmaya, welcome to EE!
Please read guidelines regarding Comments vs. answers at bottom of page
Cheers and happy coding
Please read guidelines regarding Comments vs. answers at bottom of page
Cheers and happy coding
ASKER
Nice API but it doesn't return the network path. \\network\path
ASKER
Nice API but it doesn't return the network path. \\network\path
ASKER
Nice API but it doesn't return the network path. \\network\path
ASKER
Wish I could figure out how to return the \\network\path given a drive letter.
Set a reference to the Microsoft Scripting Runtime object
Private Sub Command1_Click()
Dim strShareName As String
strShareName = GetMapping("K")
End Sub
Public Function GetMapping(ByVal varDrive As String) As String
Dim fldr As Folder
Dim fso As New FileSystemObject
Dim drv As Drive
On Error GoTo err_mapping
Set drv = fso.GetDrive(fso.GetDriveN
GetMapping = drv.ShareName
Exit Function
err_mapping:
MsgBox UCase(varDrive) & ":" & "drive Not mapped"
End Function
Private Sub Command1_Click()
Dim strShareName As String
strShareName = GetMapping("K")
End Sub
Public Function GetMapping(ByVal varDrive As String) As String
Dim fldr As Folder
Dim fso As New FileSystemObject
Dim drv As Drive
On Error GoTo err_mapping
Set drv = fso.GetDrive(fso.GetDriveN
GetMapping = drv.ShareName
Exit Function
err_mapping:
MsgBox UCase(varDrive) & ":" & "drive Not mapped"
End Function
ASKER
Thanks RichW. Created a new question with 25 points for you to collect.
'Place is listbox on your form
Private Sub cmdInfo_Click()
'
Dim fldr As Folder
Dim fso As New FileSystemObject
Dim drv As Drive
'
Set drv = fso.GetDrive(fso.GetDriveN
'
With List1
.AddItem "Available space: " & FormatNumber(drv.Available
.AddItem "Drive letter: " & drv.DriveLetter
.AddItem "Drive type: " & drv.DriveType
.AddItem "Drive file system: " & drv.FileSystem
.AddItem "Drive free space: " & FormatNumber(drv.FreeSpace
.AddItem "Drive is ready: " & drv.IsReady
.AddItem "Drive path: " & drv.Path
.AddItem "Root folder: " & drv.RootFolder
.AddItem "Serial number: " & drv.SerialNumber
.AddItem "Share name: " & drv.ShareName
.AddItem "Total size: " & FormatNumber(drv.TotalSize
.AddItem "Volume name : " & drv.VolumeName
End With
'
End Sub
RichW