Solved

VBA - Adding default location to Folder Path dialog box

Posted on 2010-09-07
14
732 Views
Last Modified: 2012-05-10
Hi,

I have code to open up a specfic location on the users computer to save their files.  This opens up with the default directoer being C:\.  Is there any way that I can set it such that it defaults to C:\Main\ExcelDoc\, yest still have the ability to change it, if this is not where they want to save it?  See my code below.
Function GetFolderPath() As String

    Dim oShell As Object

    Set oShell = CreateObject("Shell.Application"). _

    BrowseForFolder(0, "Please select folder", 0, "c:\\")

    If Not oShell Is Nothing Then

        GetFolderPath = oShell.Items.Item.Path

    Else

        GetFolderPath = vbNullString

    End If

    Set oShell = Nothing

End Function

Open in new window

0
Comment
Question by:NerishaB
  • 6
  • 4
  • 4
14 Comments
 
LVL 47

Expert Comment

by:Wayne Taylor (webtubbs)
Comment Utility
You simply need to modify the 4th parameter of the BrowseForFolder function...

    BrowseForFolder(0, "Please select folder", 0, "C:\Main\ExcelDoc\")

Wayne
0
 

Author Comment

by:NerishaB
Comment Utility
I have tried that.  But I want it to default to that, but there is no option for the user to go back up to search for another folder.  For instance, if the user wants to save it to the desktop.  
0
 
LVL 85

Expert Comment

by:Rory Archibald
Comment Utility
For example:



Function GetFolder() As String

    Dim dlg As FileDialog

    Set dlg = Application.FileDialog(msoFileDialogFolderPicker)

    dlg.InitialFileName = "C:\Main\ExcelDoc\"

    If dlg.Show = -1 Then

        GetFolder = dlg.SelectedItems(1)

    End If

End Function

Open in new window

0
 
LVL 47

Accepted Solution

by:
Wayne Taylor (webtubbs) earned 500 total points
Comment Utility
That's true. The 4th parameter specifies the root directory, meaning the user cannot select a folder higher than that.

Take a look at this question, which shows how you can get around this....

http://www.experts-exchange.com/Programming/Languages/Visual_Basic/Q_21716577.html

The below code is a modification of the above, which doesn't not use a Form. Sample usage would be like this....

    getdir = BrowseForFolder(Application.hwnd, "Select A Directory", "C:\Main\ExcelDoc\")
    If Len(getdir) = 0 Then Exit Sub  'user selected cancel
    MsgBox getdir

Wayne
Option Explicit

Private Const BIF_STATUSTEXT = &H4&
Private Const BIF_RETURNONLYFSDIRS = 1
Private Const BIF_DONTGOBELOWDOMAIN = 2
Private Const MAX_PATH = 260

Private Const WM_USER = &H400
Private Const BFFM_INITIALIZED = 1
Private Const BFFM_SELCHANGED = 2
Private Const BFFM_SETSTATUSTEXT = (WM_USER + 100)
Private Const BFFM_SETSELECTION = (WM_USER + 102)

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long

Private Type BrowseInfo
  hWndOwner      As Long
  pIDLRoot       As Long
  pszDisplayName As Long
  lpszTitle      As Long
  ulFlags        As Long
  lpfnCallback   As Long
  lParam         As Long
  iImage         As Long
End Type

Private m_CurrentDirectory As String   'The current directory
'

Public Function BrowseForFolder(hwnd, Title As String, StartDir As String) As String
  'Opens a Treeview control that displays the directories in a computer

  Dim lpIDList As Long
  Dim szTitle As String
  Dim sBuffer As String
  Dim tBrowseInfo As BrowseInfo
  m_CurrentDirectory = StartDir & vbNullChar

  szTitle = Title
  With tBrowseInfo
    .hWndOwner = hwnd
    .lpszTitle = lstrcat(szTitle, "")
    .ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN + BIF_STATUSTEXT
    .lpfnCallback = GetAddressofFunction(AddressOf BrowseCallbackProc)  'get address of function.
  End With

  lpIDList = SHBrowseForFolder(tBrowseInfo)
  If (lpIDList) Then
    sBuffer = Space(MAX_PATH)
    SHGetPathFromIDList lpIDList, sBuffer
    sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
    BrowseForFolder = sBuffer
  Else
    BrowseForFolder = ""
  End If
 
End Function
 
Private Function BrowseCallbackProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal lp As Long, ByVal pData As Long) As Long
 
  Dim lpIDList As Long
  Dim ret As Long
  Dim sBuffer As String
 
  On Error Resume Next  'Sugested by MS to prevent an error from
                        'propagating back into the calling process.
     
  Select Case uMsg
 
    Case BFFM_INITIALIZED
      Call SendMessage(hwnd, BFFM_SETSELECTION, 1, m_CurrentDirectory)
     
    Case BFFM_SELCHANGED
      sBuffer = Space(MAX_PATH)
     
      ret = SHGetPathFromIDList(lp, sBuffer)
      If ret = 1 Then
        Call SendMessage(hwnd, BFFM_SETSTATUSTEXT, 0, sBuffer)
      End If
     
  End Select
 
  BrowseCallbackProc = 0
 
End Function

' This function allows you to assign a function pointer to a vaiable.
Private Function GetAddressofFunction(add As Long) As Long
  GetAddressofFunction = add
End Function

Open in new window

0
 
LVL 47

Expert Comment

by:Wayne Taylor (webtubbs)
Comment Utility
I did not know Excel had a Folder Picker available. Live and learn....
0
 

Author Comment

by:NerishaB
Comment Utility
@ wetubbs:

Where would I put that code??
0
 

Author Closing Comment

by:NerishaB
Comment Utility
Thanks, I put it at the top of my code.  Works brilliantly.
0
What Is Threat Intelligence?

Threat intelligence is often discussed, but rarely understood. Starting with a precise definition, along with clear business goals, is essential.

 
LVL 47

Expert Comment

by:Wayne Taylor (webtubbs)
Comment Utility
NerishaB,

Thank you for the accept, but I do have to ask, did you see Rory's code at http:#a33616632 ?

Wayne
0
 
LVL 85

Expert Comment

by:Rory Archibald
Comment Utility
93 lines of code looks more impressive than 8. ;)
0
 

Author Comment

by:NerishaB
Comment Utility
Yes wetubbs, I did look at rorya's code.  It does work, but I am creating this for a client that is very difficult.  He did not like the fact that I changed the way the initial browse for folder screen.  Sorry rorya.  Yours did work though. :-)
0
 
LVL 85

Expert Comment

by:Rory Archibald
Comment Utility
No problem - the only important thing is that you have a solution! :)
0
 

Author Comment

by:NerishaB
Comment Utility
Actually, wetubbs, with your code in place, I just tested it now and found out that even though I set it to save to a default location, it always saves my files to the c: Drive.  See my code below:

I call it with the following function:
Function GetFolderPath() As String
   Dim getdir As String
     getdir = BrowseForFolder(Application.hwnd, "Select a Directory", "C:\Netserver\oztech_dev_oz\oz_excel\")
     If Len(getdir) = 0 Then
       Exit Function
    MsgBox getdir
    End If
     
End Function
Option Explicit

Public FromProj As VBIDE.VBProject, ToProj As VBIDE.VBProject

Public ImpExp As Integer

Public WName As String

Public ExpName As String



Private Const BIF_STATUSTEXT = &H4&

Private Const BIF_RETURNONLYFSDIRS = 1

Private Const BIF_DONTGOBELOWDOMAIN = 2

Private Const MAX_PATH = 260



Private Const WM_USER = &H400

Private Const BFFM_INITIALIZED = 1

Private Const BFFM_SELCHANGED = 2

Private Const BFFM_SETSTATUSTEXT = (WM_USER + 100)

Private Const BFFM_SETSELECTION = (WM_USER + 102)



Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long

Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long

Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long

Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long



Private Type BrowseInfo

  hWndOwner      As Long

  pIDLRoot       As Long

  pszDisplayName As Long

  lpszTitle      As Long

  ulFlags        As Long

  lpfnCallback   As Long

  lParam         As Long

  iImage         As Long

End Type



Private m_CurrentDirectory As String   'The current directory

'



Public Function BrowseForFolder(hwnd, Title As String, StartDir As String) As String

  'Opens a Treeview control that displays the directories in a computer



  Dim lpIDList As Long

  Dim szTitle As String

  Dim sBuffer As String

  Dim tBrowseInfo As BrowseInfo

  m_CurrentDirectory = StartDir & vbNullChar



  szTitle = Title

  With tBrowseInfo

    .hWndOwner = hwnd

    .lpszTitle = lstrcat(szTitle, "")

    .ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN + BIF_STATUSTEXT

    .lpfnCallback = GetAddressofFunction(AddressOf BrowseCallbackProc)  'get address of function.

  End With



  lpIDList = SHBrowseForFolder(tBrowseInfo)

  If (lpIDList) Then

    sBuffer = Space(MAX_PATH)

    SHGetPathFromIDList lpIDList, sBuffer

    sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)

    BrowseForFolder = sBuffer

  Else

    BrowseForFolder = ""

  End If

 

End Function

 

Private Function BrowseCallbackProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal lp As Long, ByVal pData As Long) As Long

 

  Dim lpIDList As Long

  Dim ret As Long

  Dim sBuffer As String

 

  On Error Resume Next  'Sugested by MS to prevent an error from

                        'propagating back into the calling process.

     

  Select Case uMsg

 

    Case BFFM_INITIALIZED

      Call SendMessage(hwnd, BFFM_SETSELECTION, 1, m_CurrentDirectory)

     

    Case BFFM_SELCHANGED

      sBuffer = Space(MAX_PATH)

     

      ret = SHGetPathFromIDList(lp, sBuffer)

      If ret = 1 Then

        Call SendMessage(hwnd, BFFM_SETSTATUSTEXT, 0, sBuffer)

      End If

     

  End Select

 

  BrowseCallbackProc = 0

 

End Function



' This function allows you to assign a function pointer to a vaiable.

Private Function GetAddressofFunction(add As Long) As Long

  GetAddressofFunction = add

End Function

Open in new window

0
 
LVL 85

Expert Comment

by:Rory Archibald
Comment Utility
You don't actually return the folder:



Function GetFolderPath() As String

   Dim getdir As String

     getdir = BrowseForFolder(Application.hwnd, "Select a Directory", "C:\Netserver\oztech_dev_oz\oz_excel\")

     If Len(getdir) = 0 Then

       Exit Function



    End If

    GetFolderPath = getdir

End Function

Open in new window

0
 

Author Comment

by:NerishaB
Comment Utility
Thanks, got it now.
0

Featured Post

6 Surprising Benefits of Threat Intelligence

All sorts of threat intelligence is available on the web. Intelligence you can learn from, and use to anticipate and prepare for future attacks.

Join & Write a Comment

Introduction While answering a recent question (http:/Q_27311462.html), I created an alternative function to the Excel Concatenate() function that you might find useful.  I tested several solutions and share the results in this article as well as t…
Approximate matching with VLOOKUP and MATCH seems to me to be a greatly under-used technique, and one which is vital for getting good performance out of large lookups. Until recently I would always have advised using an exact match for simplicity an…
This Micro Tutorial demonstrate the bugs in Microsoft Excel for Mac with Pivot Charts.
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…

763 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

6 Experts available now in Live!

Get 1:1 Help Now