Author Topic: Browse to directory  (Read 4713 times)

0 Members and 1 Guest are viewing this topic.

Amsterdammed

  • Swamp Rat
  • Posts: 507
  • Revit MEP 2016 Acad2013, OPEN DCL
Browse to directory
« on: June 18, 2005, 10:09:31 AM »
Hello,


I want to add a button to a Excel sheet that allows the user to browse to a desired directory and this path should be than written to a cell (ok, that’s not the problem).

With all the thanks in advance,
Bernd
Bernd

TR

  • Guest
Browse to directory
« Reply #1 on: June 18, 2005, 10:23:17 AM »
Google for "frank oquendo common dialog control". The class he compiled is top shelf and works quite well.

Or you could look at the sweet API tutorial that Keith put together and make your own.

Amsterdammed

  • Swamp Rat
  • Posts: 507
  • Revit MEP 2016 Acad2013, OPEN DCL
Browse to directory
« Reply #2 on: June 18, 2005, 11:24:52 AM »
:?: Tim,

API tutorial ?

Obviously I'm not that familiar with all the Swamp features. Can you help me out, please?

Thanks, Bernd
Bernd

TR

  • Guest
Browse to directory
« Reply #3 on: June 18, 2005, 11:32:07 AM »
I'm refering to an item posted in the "VBA Course" forum. Since you are unaware I assume you are not a member of that group. I'm sure if you contact Mark he'd be more than happy to give you access to that forum.

Amsterdammed

  • Swamp Rat
  • Posts: 507
  • Revit MEP 2016 Acad2013, OPEN DCL
Browse to directory
« Reply #4 on: June 18, 2005, 11:36:08 AM »
:) Thanks Tim,

I will do so. VBA is normally not what I'm doing (but i want to focus more on), so any source off Help is very welcome.

Bernd
Bernd

Mark

  • Custom Title
  • Seagull
  • Posts: 28725
Browse to directory
« Reply #5 on: June 18, 2005, 11:38:13 AM »
Quote from: Tim Riley
I'm sure if you contact Mark he'd be more than happy to give you access to that forum.

Actually CmdrDuh is in charge of that group. But I'm sure he'd be glad to add you to it.
TheSwamp.org  (serving the CAD community since 2003)

TR

  • Guest
Browse to directory
« Reply #6 on: June 18, 2005, 11:42:01 AM »
Oops.  :oops:

Amsterdammed

  • Swamp Rat
  • Posts: 507
  • Revit MEP 2016 Acad2013, OPEN DCL
Browse to directory
« Reply #7 on: June 18, 2005, 12:00:36 PM »
Tanks Mark

Bernd
Bernd

Keith™

  • Villiage Idiot
  • Seagull
  • Posts: 16897
  • Superior Stupidity at its best
Browse to directory
« Reply #8 on: June 18, 2005, 01:49:36 PM »
Here is a simple one that won't require to much knowledge of VBA
Code: [Select]

Option Explicit

Public 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

Public Const MAX_PATH = 2600

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

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

Public Function ReturnFolder(ByVal Prompt As String) As String
  Dim Browser As BROWSEINFO
  Dim lngFolder As Long
  Dim strPath As String
  With Browser
    .hOwner = 0&
    .lpszTitle = Prompt
    .pszDisplayName = String(MAX_PATH, 0)
  End With
  strPath = String(MAX_PATH, 0)
  lngFolder = SHBrowseForFolder(Browser)
  If lngFolder Then
    SHGetPathFromIDList lngFolder, strPath
    ReturnFolder = Left(strPath, InStr(strPath, vbNullChar) - 1)
  End If
End Function


Put it in a new module and then call the dialog like so:
Code: [Select]

Path = Module1.ReturnFolder("Select Folder")


Enjoy
Proud provider of opinion and arrogance since November 22, 2003 at 09:35:31 am
CadJockey Militia Field Marshal

Find me on https://parler.com @kblackie

Amsterdammed

  • Swamp Rat
  • Posts: 507
  • Revit MEP 2016 Acad2013, OPEN DCL
Browse to directory
« Reply #9 on: June 19, 2005, 10:00:06 AM »
:D Keith,
you are great.

That's true; thanks to you it doesn't require knowledge of VBA
at all. It works perfect.


This helps me a lot to make my stuff look really pro. :cheesy:

Thanks a lot, Bernd
Bernd

Keith™

  • Villiage Idiot
  • Seagull
  • Posts: 16897
  • Superior Stupidity at its best
Browse to directory
« Reply #10 on: June 19, 2005, 02:48:12 PM »
you are very welcome
Proud provider of opinion and arrogance since November 22, 2003 at 09:35:31 am
CadJockey Militia Field Marshal

Find me on https://parler.com @kblackie

Jürg Menzi

  • Swamp Rat
  • Posts: 598
  • Oberegg, Switzerland
Browse to directory
« Reply #11 on: June 25, 2005, 07:43:31 AM »
If you wanna have a default path for the folder dialog use:
Code: [Select]
Declare Function SHBrowseForFolder Lib "shell32" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Declare Function SHGetPathFromIDList Lib "shell32" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Declare Sub CoTaskMemFree Lib "ole32" (ByVal pv As Long)
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal dwLength As Long)
Declare Function LocalAlloc Lib "kernel32" (ByVal uFlags As Long, ByVal uBytes As Long) As Long
Declare Function LocalFree Lib "kernel32" (ByVal hMem As Long) As Long

Public Const WM_USER = &H400
Public Const BFFM_INITIALIZED = 1
Public Const BFFM_SETSTATUSTEXTA As Long = (WM_USER + 100)
Public Const BFFM_SETSTATUSTEXTW As Long = (WM_USER + 104)
Public Const BFFM_ENABLEOK As Long = (WM_USER + 101)
Public Const BFFM_SETSELECTIONA As Long = (WM_USER + 102)
Public Const BFFM_SETSELECTIONW As Long = (WM_USER + 103)
Public Const LMEM_FIXED = &H0
Public Const LMEM_ZEROINIT = &H40
Public Const LPTR = (LMEM_FIXED Or LMEM_ZEROINIT)

Public Const MAX_PATH = 2600

Public 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
'
' - Function MeBrowseForFolderByPath
'   Description:
'     Opens the folder dialog with a default path.
'   Arguments:
'     - DefPth = Default path
'     - DlgTit = Dialog title
'   Returns:
'     - Path
'     - "" on cancel or error
'   Exceptions:
'     - None
'   Notes:
'     - Based on 'Pre-selecting a Folder using the Browse Callback'
'       by Randy Birch, VBnet
'       Copyright ©1996-2004 VBnet, Randy Birch, All Rights Reserved.
'
Public Function MeBrowseForFolderByPath(ByVal DefPth As String, ByVal DlgTit As String) As String

  Dim BrwInf As BROWSEINFO
  Dim FoPidl As Long
  Dim SelPth As Long
  Dim RetVal As String * MAX_PATH
 
  With BrwInf
    .hOwner = ThisDrawing.hWnd
    .pidlRoot = 0
    .lpszTitle = DlgTit
    .lpfn = MeFarProc(AddressOf MeBrowseCallbackProcStr)
    SelPth = LocalAlloc(LPTR, Len(DefPth) + 1)
    CopyMemory ByVal SelPth, ByVal DefPth, Len(DefPth) + 1
    .lParam = SelPth
  End With
 
  FoPidl = SHBrowseForFolder(BrwInf)
 
  If FoPidl Then
    If SHGetPathFromIDList(FoPidl, RetVal) Then
       MeBrowseForFolderByPath = MeCutNulls(RetVal)
    Else
       MeBrowseForFolderByPath = ""
    End If
    Call CoTaskMemFree(FoPidl)
  Else
    MeBrowseForFolderByPath = ""
  End If
 
  Call LocalFree(SelPth)

End Function
'
' Callback for the Browse STRING method.
' On initialization, set the dialog's
' pre-selected folder from the pointer
' to the path allocated as BrwInf.lParam,
' passed back to the callback as lpData param.
'
Public Function MeBrowseCallbackProcStr(ByVal CurHdl As Long, ByVal UsrMsg As Long, ByVal TmpPrm As Long, _
                                        ByVal CurDat As Long) As Long

   Select Case UsrMsg
    Case BFFM_INITIALIZED
      Call SendMessage(CurHdl, BFFM_SETSELECTIONA, True, ByVal CurDat)
    Case Else:
   End Select
         
End Function
'
' A dummy procedure that receives and returns
' the value of the AddressOf operator.
' This workaround is needed as you can't
' assign AddressOf directly to a member of a
' user-defined type, but you can assign it
' to another long and use that instead!
'
Public Function MeFarProc(AdrVal As Long) As Long
 
  MeFarProc = AdrVal

End Function
'
' Removes 'Nulls' in a string.
'
Public Function MeCutNulls(ByVal StrNul As String) As String

  MeCutNulls = Left$(StrNul, InStr(StrNul, Chr$(0)) - 1)
 
End Function
Cheers
A computer's human touch is its unscrupulousness!
MENZI ENGINEERING GmbH
Current A2k16... A2k21 - Start R2.18

Amsterdammed

  • Swamp Rat
  • Posts: 507
  • Revit MEP 2016 Acad2013, OPEN DCL
Browse to directory
« Reply #12 on: June 25, 2005, 08:33:21 AM »
Juerg,
I'm just back in Amsterdam and my Internet at home is disconected (can happen when you are in Florida to long with an expensive girlfriend, not taking care  of all the bills :( ), so I'm in an Internet cafe and can't try your code but i know it will work.

But i wonder, don't you sleep some times? :?:

I know in German "selbststaendig" means working "selbst" and "staendig" :mrgreen:

Bernd
Bernd

Jürg Menzi

  • Swamp Rat
  • Posts: 598
  • Oberegg, Switzerland
Browse to directory
« Reply #13 on: June 25, 2005, 08:56:11 AM »
Quote from: Amsterdammed
But i wonder, don't you sleep some times?
Yeah, some times...but just back from my holidays I've enough power to keep things alive... :mrgreen:
Quote from: Amsterdammed
I know in German "selbststaendig" means working "selbst" and "staendig"
You hit the nail on his head :D

Cheers
A computer's human touch is its unscrupulousness!
MENZI ENGINEERING GmbH
Current A2k16... A2k21 - Start R2.18