Directory path indication

• • Reply

  13 years ago

  by Holmes.vk

  Viktor

  Kiev, Ukraine, Ukraine

  Joined 15 years ago

  Hi Everyone,

   Pls. help -

   In my application I'm using a button to open a Folder under pre-storied path. The path spelling itself is storied in DB.

  Every time i want to change the destination path i have to copy the new destination path manually to DB and only then use that button for opening.

  Is it possible to use a program code for choosing the destination directory and save the path spelling to a variable? (something similar to 'Open...' command in Windows applications but the result should be not a file name but a Directory path)

  Thanks in advance :) 

  Holmes. 

   

   

   

  Report abuse
• • Reply

  13 years ago

  by raja-79

  raja mohd hisham

  Selangor, Malaysia

  Joined 14 years ago

  Hi Holmes

  I do have one solution for your problem above but I don't know if this solution helpful and if its helpful I hope it not too late. All you need is just a command button and list.

  First of all you need to declare these, either in module or just in your form:

  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

  Dim b1 As BROWSEINFO
  Dim r As Long
  Dim fPath As String
  Dim fName As String
  Dim foldB As Long
  Dim tempPath As String
  Dim Pos As Integer
   
  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
  

  Then you need to apply this function afterward:

  Private Function GetBrowsersDirectory() As String
      foldB = SHBrowseForFolder(b1)
      tempPath = Space$(512)
      r = SHGetPathFromIDList(ByVal foldB, ByVal tempPath)
      If r Then
          Pos = InStr(tempPath, Chr$(0))
          tempPath = Left(tempPath, Pos - 1)
          GetBrowsersDirectory = tempPath
      Else: GetBrowsersDirectory = ""
      End If
  End Function
  

  Then under command button which I name command1 you put this code:

  Private Sub Command1_Click()
  On Error Resume Next

  fPath$ = GetBrowsersDirectory$()
  If fPath$ > "" Then
      fName$ = fPath
      SetAttr fName, vbReadOnly
      List1.AddItem LCase(fName)
  End If
  'If you want to remove duplicate folder on the list
  Dim i, x
  For i = 0 To List1.ListCount - 1
      For x = 0 To List1.ListCount - 1
          If i = x Then GoTo NextX
              If LCase(List1.List(x)) = LCase(List1.List(i)) Then
                  List1.RemoveItem x
              End If
  NextX:
      Next x
  Next i
             
  End Sub
  

  Hope this solution is helpful and can solve your problem.

  Regards;

  Raja Mohd Hisham

  Report abuse
• • Reply

  13 years ago

  by Holmes.vk

  Viktor

  Kiev, Ukraine, Ukraine

  Joined 15 years ago

  Hi Raja,

  Thanks a lot for your help. this is exactly what i need.

  With the Best regards,

  Holmes.

  Report abuse