VBA to identify network places

[rib742]

I've searched several posts and cannot find what I'm looking for. What I want to be able to do is have a list of all the share networks that a user is mapped to when a form opens based on their username. I've got the form to display the users name using ENVIRON("USERNAME"). however, I'm at a lost for being able to bring in a list of all the share drives that user is mapped to. I want to do this via VBA.

Any ideas?

 

[PHV]

A starting point:
CreateObject("WScript.Shell").Run "cmd /k net use"

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[dhookom]

I would not use Environ() since users can change this. Consider using API calls. There are functions for most of what you want at

http://www.mvps.org/access/api/index.html.

Get Local Drives and UNC Path of network drives

http://www.mvps.org/access/api/api0003.htm

Network User Name

http://www.mvps.org/access/api/api0008.htm

Duane MS Access MVP
[green]Ask a great question, get a great answer.[/green] [red]Ask a vague question, get a vague answer.[/red]
[green]Find out how to get great answers faq219-2884.[/green]

 

[Ed2020]

Adapted from code on microsoft.com:

Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" _
    (ByVal nDrive As String) As Long

Private Declare Function GetLogicalDriveStrings Lib "kernel32" _
    Alias "GetLogicalDriveStringsA" _
    (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long

Const DRIVE_CDROM& = 4

Public Function GetDriveStrings() As String
    ' Wrapper for calling the GetLogicalDriveStrings api
    
    Dim result As Long          ' Result of our API calls
    Dim strDrives As String     ' String to pass to API call
    Dim lenStrDrives As Long    ' Length of the above string
    
    ' Call GetLogicalDriveStrings with a buffer size of zero to
    ' find out how large our stringbuffer needs to be
    result = GetLogicalDriveStrings(0, strDrives)
    
    strDrives = String(result, 0)
    lenStrDrives = result
    
    ' Call again with our new buffer
    result = GetLogicalDriveStrings(lenStrDrives, strDrives)
    
    If result = 0 Then
        ' There was some error calling the API
        ' Pass back an empty string
        ' NOTE - TODO: Implement proper error handling here
        GetDriveStrings = ""
    Else
        GetDriveStrings = strDrives
    End If
End Function

Public Sub ListMappedDrives()
    Dim strDrives As String
    
    ' Find out what drives we have on this machine
    strDrives = GetDriveStrings()
    
    If strDrives = "" Then
        ' No drives were found
        MsgBox "No Drives were found!", vbCritical
    Else
        ' Walk through the string and check the type of each drive
        ' displaying any cd-rom drives we find
        Dim pos As Long
        Dim drive As String
        Dim drivetype As Long
        
        pos = 1
        
        Do While Not Mid$(strDrives, pos, 1) = Chr(0)
            drive = Mid$(strDrives, pos, 3)
            pos = pos + 4
            drivetype = GetDriveType(drive)
            If drivetype = DRIVE_CDROM Then
                MsgBox "Mapped drive found at drive " & UCase(drive)
            End If
        Loop
    End If
End Sub

Ed Metcalfe

Please do not feed the trolls.....