I am using code which I found from a reputable online source, which has worked perfectly until one of our users installed Office 2016 - 64 bit. The issue seems to be the 64 bit version of Office. I have learned that the code can be modified by using 'PtrSafe' & 'LongPtr'. I am comfortable with adding the 'PtrSafe' but I do not know which or how many of the original 'Long' statements must be changed.
I have included all the code from this module, in case it is of help, but I suspect that the changes will only need to be made in the code preceeding the 'Function fnUNCPath(strDriveLetter As String) As String' line. I may be wrong with this assumption, so that is why I included all the code.
Thank you in advance for your assistance.
Option Explicit
'********************************************************************************************
'********************************************************************************************
'*** IMPORTANT ***
'*** "Microsoft Scripting Runtime" ***
'*** MUST be enabled in order for this to function properly ***
'*** ***
'*** VBA Editor Toolbar > Tools > References > Microsoft Scripting Runtime ***
'*** ***
'********************************************************************************************
'********************************************************************************************
'Drive Types
Private Const DRIVE_UNKNOWN = 0
Private Const DRIVE_ABSENT = 1
Private Const DRIVE_REMOVABLE = 2
Private Const DRIVE_FIXED = 3
Private Const DRIVE_REMOTE = 4
Private Const DRIVE_CDROM = 5
Private Const DRIVE_RAMDISK = 6
' returns errors for UNC Path
Private Const ERROR_BAD_DEVICE = 1200&
Private Const ERROR_CONNECTION_UNAVAIL = 1201&
Private Const ERROR_EXTENDED_ERROR = 1208&
Private Const ERROR_MORE_DATA = 234
Private Const ERROR_NOT_SUPPORTED = 50&
Private Const ERROR_NO_NET_OR_BAD_PATH = 1203&
Private Const ERROR_NO_NETWORK = 1222&
Private Const ERROR_NOT_CONNECTED = 2250&
Private Const NO_ERROR = 0
Private Declare PtrSafe Function WNetGetConnection Lib "mpr.dll" Alias _
"WNetGetConnectionA" (ByVal lpszLocalName As String, _
ByVal lpszRemoteName As String, cbRemoteName As Long) As Long
Private Declare PtrSafe Function GetLogicalDriveStrings Lib "KERNEL32" Alias _
"GetLogicalDriveStringsA" (ByVal nBufferLength As Long, _
ByVal lpBuffer As String) As Long 'Long type is compatible with 32 bit, I think
Private Declare PtrSafe Function GetDriveType Lib "KERNEL32" Alias "GetDriveTypeA" _
(ByVal nDrive As String) As LongPtr 'Function has been updated
Declare PtrSafe Function WNetGetConnection32 _
Lib "mpr.dll" _
Alias "WNetGetConnectionA" ( _
ByVal lpszLocalName As String, _
ByVal lpszRemoteName As String, _
lSize As Long) As Long
'// 32-bit declarations:
Dim lpszRemoteName As String
Dim lSize As Long
'// Use for the return value of WNetGetConnection() API.
'Const NO_ERROR As Long = 0
'// The size used for the string buffer. Adjust this if you
'// need a larger buffer.
Const lBUFFER_SIZE As Long = 1052
Function fnUNCPath(strDriveLetter As String) As String
'// Takes specified Local Drive Letter (e.g. E,D,H Etc) and converts to UNC
Dim cbRemoteName As Long
Dim lStatus As Long
'// Add a colon to the drive letter entered.
strDriveLetter = Left(strDriveLetter, 1) & ":"
'// Specifies the size in charaters of the buffer.
cbRemoteName = lBUFFER_SIZE
'// Prepare a string variable by padding spaces.
lpszRemoteName = lpszRemoteName & Space(lBUFFER_SIZE)
'// Return the UNC path (eg.\\Server\Share).
lStatus = WNetGetConnection32( _
strDriveLetter, _
lpszRemoteName, _
cbRemoteName)
'// Has WNetGetConnection() succeeded.
'// WNetGetConnection()returns 0 (NO_ERROR)
'// if it succesfully retrieves the UNC path.
'If the referenced file is a mapped network, this will assign the UNC path. PR
If lStatus = NO_ERROR Then
'// Get UNC path.
fnUNCPath = lpszRemoteName
End If
'Else
'// Unable to obtain the UNC path.
''' fnUNCPath = "NO UNC path"
'Determine Drive type, to be able to assign UNC prefix
Dim fDriveTypeResult As String
Dim strDrive As String
fDriveTypeResult = fDriveType(strDrive)
'If the referenced file is a local file (Fixed Drive), this will assign the computer name, which will be used in the UNC path. PR
If fDriveTypeResult = "Fixed Drive" Then
fnUNCPath = "\\" & Environ("ComputerName")
End If
'If the referenced file is a Removeable Disk, this will assign the volume name, which will be used in the UNC path. PR
If fDriveTypeResult = "Removable Media" Then
fnUNCPath = strDriveLetter
End If
End Function
Function fDriveType(strDriveName As String) As String
Dim lngRet As Long
Dim strDrive As String
lngRet = GetDriveType(strDriveName)
Select Case lngRet
Case DRIVE_UNKNOWN 'The drive type cannot be determined.
strDrive = "Unknown Drive Type"
Case DRIVE_ABSENT 'The root directory does not exist.
strDrive = "Drive does not exist"
Case DRIVE_REMOVABLE 'The drive can be removed from the drive.
strDrive = "Removable Media"
Case DRIVE_FIXED 'The disk cannot be removed from the drive.
strDrive = "Fixed Drive"
Case DRIVE_REMOTE 'The drive is a remote (network) drive.
strDrive = "Network Drive"
Case DRIVE_CDROM 'The drive is a CD-ROM drive.
strDrive = "CD Rom"
Case DRIVE_RAMDISK 'The drive is a RAM disk.
strDrive = "Ram Disk"
End Select
fDriveType = strDrive
End Function
Bookmarks