none
Mapping a network drive without using letters RRS feed

  • Question

  • Hey everyone

    Im trying to map a networkdrive with vba for multiple users. My problem is, that i need to map the drive without using the letter infront of it, but instead using the name of the drive. This is because the drive is not called the same on all the different computers that need to map the drive. My code looks like this:

        With ActiveSheet.QueryTables.Add(Connection:=Array(Array( _
            "ODBC;DSN=MS Access Database;DBQ=E:\Datarapportering\A2DBweb_DQA_Autodata.mdb;DefaultDir=E:\Datarapportering;DriverId=25;FIL=MS Acces" _
            ), Array("s;MaxBufferSize=2048;PageTimeout=5;")), Destination:=Range("B7"))
            .CommandText = Array( _
            "SELECT `KPI CMC NC1`.DepartmentNo, `KPI CMC NC1`.NCClosedDate, `KPI CMC NC1`.NCIdentifiedDate, `KPI CMC NC1`.`Antal dage`, `KPI CMC NC1`.NCStatusDate, `KPI CMC NC1`.NCNo" & Chr(13) & "" & Chr(10) & "FROM `E:\Datarapportering\A2D" _
            , _
            "Bweb_DQA_Autodata`.`KPI CMC NC1` `KPI CMC NC1`" & Chr(13) & "" & Chr(10) & "WHERE (`KPI CMC NC1`.NCIdentifiedDate>{ts '2006-12-01 00:00:00'})" _
            )

    As you kan see it gathers data from a file on the E drive. But the E drive is called something different for some of the computers, and the document is needed on all of them.

    I hope someone out there has the time and the knowledge to help me out on this one.

    -JRQS

    Tuesday, August 23, 2011 1:50 PM

Answers

  • Set a reference to MS scripting runtime, save the file on that drive, then run the macro below. It will give you the drive name, which you can manipulate to replace the drive letter, like

    "ODBC;DSN=MS Access Database;DBQ=E:\Datarapportering\

     "ODBC;DSN=MS Access Database;DBQ=\\" & myName & "\Datarapportering ......

     

     

    Sub test()
    Dim myName As String
    myName = ConvertDrive2ServerName(ThisWorkbook.Path)
    myName = Split(myName, "\")(2)
    MsgBox myName
    End Sub


    Public Function ConvertDrive2ServerName(ByVal sFullPath As String) As String

    ' --- Replaces the DriveName with ShareName in a given string

    Dim FSO As FileSystemObject
    Dim sDrive As String
    Dim drvName As Drive
    Dim sShare As String

    On Error GoTo Err_Trap

    Set FSO = New FileSystemObject

    sDrive = FSO.GetDriveName(sFullPath)
    Set drvName = FSO.GetDrive(sDrive)
    sShare = drvName.ShareName

    If LenB(sShare) <> 0 Then
    ConvertDrive2ServerName = Replace(sFullPath, sDrive, sShare, 1, 1, vbTextCompare)
    Else
    ConvertDrive2ServerName = sFullPath
    End If
    If Not FSO Is Nothing Then Set FSO = Nothing

    ' ---------------------------------------
    ' Error Handling
    ' ---------------------------------------
    Err_Trap:
    If Err <> 0 Then
    Err.Clear
    Resume Next
    End If
    End Function


    HTH, Bernie
    • Marked as answer by JRQS Tuesday, September 6, 2011 1:01 PM
    Tuesday, August 23, 2011 3:09 PM

All replies

  • Set a reference to MS scripting runtime, save the file on that drive, then run the macro below. It will give you the drive name, which you can manipulate to replace the drive letter, like

    "ODBC;DSN=MS Access Database;DBQ=E:\Datarapportering\

     "ODBC;DSN=MS Access Database;DBQ=\\" & myName & "\Datarapportering ......

     

     

    Sub test()
    Dim myName As String
    myName = ConvertDrive2ServerName(ThisWorkbook.Path)
    myName = Split(myName, "\")(2)
    MsgBox myName
    End Sub


    Public Function ConvertDrive2ServerName(ByVal sFullPath As String) As String

    ' --- Replaces the DriveName with ShareName in a given string

    Dim FSO As FileSystemObject
    Dim sDrive As String
    Dim drvName As Drive
    Dim sShare As String

    On Error GoTo Err_Trap

    Set FSO = New FileSystemObject

    sDrive = FSO.GetDriveName(sFullPath)
    Set drvName = FSO.GetDrive(sDrive)
    sShare = drvName.ShareName

    If LenB(sShare) <> 0 Then
    ConvertDrive2ServerName = Replace(sFullPath, sDrive, sShare, 1, 1, vbTextCompare)
    Else
    ConvertDrive2ServerName = sFullPath
    End If
    If Not FSO Is Nothing Then Set FSO = Nothing

    ' ---------------------------------------
    ' Error Handling
    ' ---------------------------------------
    Err_Trap:
    If Err <> 0 Then
    Err.Clear
    Resume Next
    End If
    End Function


    HTH, Bernie
    • Marked as answer by JRQS Tuesday, September 6, 2011 1:01 PM
    Tuesday, August 23, 2011 3:09 PM
  • Hey Bernie

     

    Thanks alot for the help!

     

    Tuesday, September 6, 2011 1:01 PM
  • In addition to what Bernie suggested, here are some other methods for getting UNC paths from mapped letter drives:

    http://proofficedev.org/blog/2009/12/creating-unc-paths-from-mapped-drives/


    Regards, JP
    Tuesday, September 6, 2011 4:58 PM