UtterAccess.com
X   Site Message
(Message will auto close in 2 seconds)

Welcome to UtterAccess! Please ( Login   or   Register )

Custom Search
 
   Reply to this topicStart new topic
> Unc Paths, Access 2016    
 
   
Consonanza
post Jul 4 2019, 11:54 AM
Post#1



Posts: 167
Joined: 1-June 10



I am trying to store the UNC path to some video files on my NAS but the function I am using (see below)

CODE
'It is not to be altered or distributed,
'except as part of an application.
'You are free to use it in any application,
'provided the copyright notice is left unchanged.
'
'Code courtesy of
'Terry Kreft

Private Type BROWSEINFO
  hOwner As Long
  pidlRoot As Long
  pszDisplayName As String
  lpszTitle As String
  ulFlags As Long
  lpfn As Long
  lParam As Long
  iImage As Long
End Type

Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias _
            "SHGetPathFromIDListA" (ByVal pidl As Long, _
            ByVal pszPath As String) As Long
            
Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias _
            "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) _
            As Long
            
Private Const BIF_RETURNONLYFSDIRS = &H1
Public Function BrowseFolder(szDialogTitle As String) As String
  Dim X As Long, bi As BROWSEINFO, dwIList As Long
  Dim szPath As String, wPos As Integer
  
    With bi
        .hOwner = hWndAccessApp
        .lpszTitle = szDialogTitle
        .ulFlags = BIF_RETURNONLYFSDIRS
    End With
    
    dwIList = SHBrowseForFolder(bi)
    szPath = Space$(512)
    X = SHGetPathFromIDList(ByVal dwIList, ByVal szPath)
    
    If X Then
        wPos = InStr(szPath, Chr(0))
        BrowseFolder = Left$(szPath, wPos - 1)
    Else
        BrowseFolder = vbNullString
    End If
End Function


..insists on storing the path using the drive letter which can vary from session to session.


I want to continue to be able to store the pathname (but as a UNC path) as a global variable in my table of constants (tblConstants) by the click of a form button.

Current code is:

CODE
strFolderName = BrowseFolder("What Folder you want to select?")
strFolderName = strFolderName & "\"

strSQL = "UPDATE DISTINCTROW tblConstants SET tblConstants.fldVideoLibraryLocation = " & "'" & strFolderName & "'"
Go to the top of the page
 
DanielPineault
post Jul 4 2019, 12:07 PM
Post#2


UtterAccess VIP
Posts: 6,776
Joined: 30-June 11



One idea is to store the UNC base path as a const, or a value in a table and only save the filename or subdirectory and filename. Then you simply concatenate the 2 at runtime. This reduces the amount of redundant data being stored and makes it easy to switch root folders (switch servers...).

You can also use function such as https://visualbasic.happycodings.com/other/code6.html (untested) to take the path returned by your BrowseFolder() function and automatically convert it to UNC.


Okay, so I quickly tested and the following works fine. Look at the TestMe function at the very bottom, it's very simple for you to implement in your existing code.
CODE
'It is not to be altered or distributed,
'except as part of an application.
'You are free to use it in any application,
'provided the copyright notice is left unchanged.
'
'Code courtesy of
'Terry Kreft

Private Type BROWSEINFO
    hOwner                    As Long
    pidlRoot                  As Long
    pszDisplayName            As String
    lpszTitle                 As String
    ulFlags                   As Long
    lpfn                      As Long
    lParam                    As Long
    iImage                    As Long
End Type

Private Declare Function SHGetPathFromIDList Lib "shell32.dll" _
                                             Alias "SHGetPathFromIDListA" _
                                             (ByVal pidl As Long, _
                                              ByVal pszPath As String) As Long

Private Declare Function SHBrowseForFolder Lib "shell32.dll" _
                                           Alias "SHBrowseForFolderA" _
                                           (lpBrowseInfo As BROWSEINFO) _
                                           As Long

Private Declare Function WNetGetConnection Lib "mpr.dll" _
                                           Alias "WNetGetConnectionA" _
                                           (ByVal lpszLocalName As String, _
                                            ByVal lpszRemoteName As String, _
                                            cbRemoteName As Long) As Long

Private Const BIF_RETURNONLYFSDIRS = &H1
Public Function BrowseFolder(szDialogTitle As String) As String
    Dim X As Long, bi As BROWSEINFO, dwIList As Long
    Dim szPath As String, wPos As Integer

    With bi
        .hOwner = hWndAccessApp
        .lpszTitle = szDialogTitle
        .ulFlags = BIF_RETURNONLYFSDIRS
    End With

    dwIList = SHBrowseForFolder(bi)
    szPath = Space$(512)
    X = SHGetPathFromIDList(ByVal dwIList, ByVal szPath)

    If X Then
        wPos = InStr(szPath, Chr(0))
        BrowseFolder = Left$(szPath, wPos - 1)
    Else
        BrowseFolder = vbNullString
    End If
End Function

'Purpose   :    Returns the UNC Path given a path
'Inputs    :    sPathName           The path to convert
'Outputs   :    The UNC path of sPathName
'Notes     :    Requires NT/2000
'Revisions :
Function ConvertToUNC(ByVal sPathName As String) As String
    Dim szValue As String, szValueName As String, sUNCName As String
    Dim lErrCode As Long, lEndBuffer As Long
    Const lLenUNC             As Long = 520
    'Return values for WNetGetConnection
    Const NO_ERROR            As Long = 0
    Const ERROR_NOT_CONNECTED As Long = 2250
    Const ERROR_BAD_DEVICE = 1200&
    Const ERROR_MORE_DATA = 234
    Const ERROR_CONNECTION_UNAVAIL = 1201&
    Const ERROR_NO_NETWORK = 1222&
    Const ERROR_EXTENDED_ERROR = 1208&
    Const ERROR_NO_NET_OR_BAD_PATH = 1203&

    'Verify whether the disk is connected to the network
    If Mid$(sPathName, 2, 1) = ":" Then
        sUNCName = String$(lLenUNC, 0)
        lErrCode = WNetGetConnection(Left$(sPathName, 2), sUNCName, lLenUNC)
        lEndBuffer = InStr(sUNCName, vbNullChar) - 1
        'Can ignore the errors below (will still return the correct UNC)
        If lEndBuffer > 0 And (lErrCode = NO_ERROR Or lErrCode = ERROR_CONNECTION_UNAVAIL Or lErrCode = ERROR_NOT_CONNECTED) Then
            'Success
            sUNCName = Trim$(Left$(sUNCName, InStr(sUNCName, vbNullChar) - 1))
            ConvertToUNC = sUNCName & Mid$(sPathName, 3)
        Else
            'Error, return original path
            ConvertToUNC = sPathName
        End If
    Else
        'Already a UNC Path
        ConvertToUNC = sPathName
    End If
End Function


Function TestMe()
    strFolderName = BrowseFolder("What Folder you want to select?")
'    strFolderName = strFolderName & "\"
    Debug.Print strFolderName
    strFolderName = ConvertToUNC(strFolderName)
    Debug.Print strFolderName
End Function

--------------------
Daniel Pineault (2010-2019 Microsoft MVP)
Professional Help: http://www.cardaconsultants.com
Free MS Access Code, Tips, Tricks and Samples: http://www.devhut.net

* Design should never say "Look at me". It should always say "Look at this". -- David Craib
* A user interface is like a joke, if you have to explain it, it's not that good! -- Martin LeBlanc


All code samples, demonstration databases, links,... are provided 'AS IS' and are to be used at your own risk! Take the necessary steps to check, validate ...(you are responsible for your choices and actions)
Go to the top of the page
 
Consonanza
post Jul 4 2019, 03:25 PM
Post#3



Posts: 167
Joined: 1-June 10



Thanks Daniel,

That's exactly what I wanted. Great work.
Go to the top of the page
 
DanielPineault
post Jul 4 2019, 07:35 PM
Post#4


UtterAccess VIP
Posts: 6,776
Joined: 30-June 11



My pleasure. I'm glad it was an easy fix. thumbup.gif

--------------------
Daniel Pineault (2010-2019 Microsoft MVP)
Professional Help: http://www.cardaconsultants.com
Free MS Access Code, Tips, Tricks and Samples: http://www.devhut.net

* Design should never say "Look at me". It should always say "Look at this". -- David Craib
* A user interface is like a joke, if you have to explain it, it's not that good! -- Martin LeBlanc


All code samples, demonstration databases, links,... are provided 'AS IS' and are to be used at your own risk! Take the necessary steps to check, validate ...(you are responsible for your choices and actions)
Go to the top of the page
 
WildBird
post Jul 4 2019, 09:33 PM
Post#5


UtterAccess VIP
Posts: 3,594
Joined: 19-August 03
From: Auckland, Little Australia


I use this for UNC paths. Pass it any drive letter and will return the UNC path.

CODE
Public Function GetUNC(ByVal strPath As String) As String
'Note, this function will only return the UNC for network drives.
'Non-net drives and errors get the original value returned to them
On Error GoTo Err_GetUNC
    Const lngcBuffer As Long = 257
    Dim strUNCPath As String
    Dim strDrive As String
    If Left(strPath, 2) Like "[a-z, A-Z]:" Then
        strDrive = Left(strPath, 2)
        strUNCPath = strUNCPath & Space(lngcBuffer)
        'The function will automatically fill the strUNCPath unless there
        'is an error (return<>0), fill strPath if error
        If apiWNetGetConnection(strDrive, strUNCPath, lngcBuffer) = 0 Then
            strUNCPath = TrimNull(strUNCPath) & Mid(strPath, 3)
        Else
            strUNCPath = strPath
        End If
    End If
    If Len(Trim(strUNCPath)) = 0 Then strUNCPath = strPath
    GetUNC = strUNCPath
Exit_GetUNC:
    Exit Function
Err_GetUNC:
    MsgBox "Error " & Err.Number & " " & Err.Description
    Resume Exit_GetUNC
End Function

Private Function TrimNull(ByVal strItem As String) As String
Dim intPos As Integer
    intPos = InStr(strItem, vbNullChar)
    If intPos > 0 Then
        TrimNull = Left(strItem, intPos - 1)
    Else
        TrimNull = strItem
    End If
End Function

--------------------
Beer, natures brain defragging tool.
Go to the top of the page
 


Custom Search


RSSSearch   Top   Lo-Fi    25th August 2019 - 08:07 PM