Common Dialog API and My Documents

[retro]

I am using the Common Dialog API (http://support.microsoft.com/kb/888695) in Access 2003 to select a file.

The following part of the code dictates the initial directory opened:

Dim OpenFile As OPENFILENAME
OpenFile.lpstrInitialDir = "C:\"

Obviously, that opens in C:\, which I don't want. I want to be able to open a subdirectory of My Documents by default. However, the database has to work on several stand-alone PCs with different My Documents locations. The directory name within My Documents is always the same.

If I delete the line altogether, it seems to remember the last directory opened, but that's not an ideal solution. Is there something I can put that will go to My Documents regardless of its actual location?

Thanks in advance for any help!

 

[RuralGuy]

Unfortunately, the MyDocuments folder is located in a different location on every machine.

 

[retro]

Quite. However, Windows knows where to find it. Is there not an environment variable which refers to the location of My Documents? Something like %WinDir% or %ProgramFiles%. %UserProfile% isn't much use, as My Documents isn't necessarily in there (although it is by default).

This must be quite a popular location to access with VBA - surely there must be a solution!

 

[ByteMyzer]

Create a new Code Module, paste in the following code and save:

[COLOR="Navy"]Option Explicit

Private Declare Function[/COLOR] SHGetSpecialFolderLocation [COLOR="navy"]Lib[/COLOR] "Shell32.dll" ( _
    [COLOR="navy"]ByVal[/COLOR] hwndOwner [COLOR="navy"]As Long[/COLOR], _
    [COLOR="navy"]ByVal[/COLOR] nFolder [COLOR="navy"]As Long[/COLOR], _
    pidl [COLOR="navy"]As[/COLOR] ITEMIDLIST) _
    [COLOR="navy"]As Long

Private Declare Function[/COLOR] SHGetPathFromIDListA [COLOR="navy"]Lib[/COLOR] "Shell32.dll" ( _
    [COLOR="navy"]ByVal[/COLOR] pidl [COLOR="navy"]As Long[/COLOR], _
    [COLOR="navy"]ByVal[/COLOR] pszPath [COLOR="navy"]As String[/COLOR]) _
    [COLOR="navy"]As Long

Private Type[/COLOR] SHITEMID
    cb [COLOR="navy"]As Long[/COLOR]
    abID [COLOR="navy"]As Byte
End Type

Private Type[/COLOR] ITEMIDLIST
    mkid [COLOR="navy"]As[/COLOR] SHITEMID
[COLOR="navy"]End Type

Private Const[/COLOR] MAX_PATH [COLOR="navy"]As Integer[/COLOR] = 260

[COLOR="navy"]Public Function[/COLOR] fGetSpecialFolder(CSIDL [COLOR="navy"]As Long[/COLOR]) [COLOR="navy"]As String
    Dim[/COLOR] sPath [COLOR="navy"]As String
    Dim[/COLOR] IDL [COLOR="navy"]As[/COLOR] ITEMIDLIST
    [COLOR="DarkGreen"]'
    ' Retrieve info about system folders
    ' such as the "Recent Documents" folder.
    ' Info is stored in the IDL structure.
    '[/COLOR]
    fGetSpecialFolder = ""
    [COLOR="navy"]If[/COLOR] SHGetSpecialFolderLocation(Application.hWndAccessApp, _
                                  CSIDL, IDL) = 0 [COLOR="navy"]Then[/COLOR]
        [COLOR="darkgreen"]'
        ' Get the path from the ID list, and return the folder.
        '[/COLOR]
        sPath = Space$(MAX_PATH)
        [COLOR="navy"]If[/COLOR] SHGetPathFromIDListA([COLOR="navy"]ByVal[/COLOR] IDL.mkid.cb, [COLOR="navy"]ByVal[/COLOR] sPath) [COLOR="navy"]Then[/COLOR]
            fGetSpecialFolder = Left$(sPath, InStr(sPath, vbNullChar) - 1) _
                & ""
        [COLOR="navy"]End If
    End If
End Function[/COLOR]

The following expression will then retrieve the User's My Documents file path:

?fGetSpecialFolder(5)
C:\Documents and Settings\username\My Documents

 

[RuralGuy]

Thanks ByteMyzer. Works like a charm. Filed away for the future.

 

[retro]

Thanks ByteMyzer!

I had actually worked this one out myself, but was watching The Apprentice final here in the UK so didn't post before you'd replied.

This is how I acheived it:

I discovered that SHGetFolderPath is the way to do this in Windows. A bit of searching produced the following for VBA:

http://www.functionx.com/vbaccess2003/Lesson14e.htm

I then created the following module:

Option Compare Database
Option Explicit

Private Const MAX_PATH = 260
Private Const CSIDL_PERSONAL = &H5&
Private Const SHGFP_TYPE_CURRENT = 0

' We will use the Windows API to get the path to My Documents
Private Declare Function SHGetFolderPath Lib "shfolder" _
    Alias "SHGetFolderPathA" _
    (ByVal hwndOwner As Long, ByVal nFolder As Long, _
    ByVal hToken As Long, ByVal dwFlags As Long, _
    ByVal pszPath As String) As Long

Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
"GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long

Private Type OPENFILENAME
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    lpstrFilter As String
    lpstrCustomFilter As String
    nMaxCustFilter As Long
    nFilterIndex As Long
    lpstrFile As String
    nMaxFile As Long
    lpstrFileTitle As String
    nMaxFileTitle As Long
    lpstrInitialDir As String
    lpstrTitle As String
    flags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    lpstrDefExt As String
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
End Type

Function LaunchCD(strform As Form) As String
    Dim strMyDocuments As String
    Dim strDbName As String
    Dim valReturned As Long
    Dim dbMVD As DAO.Database
    
    ' Initialize the string
    strMyDocuments = String(MAX_PATH, 0)
    
    ' Call the Shell API function to get the path to My Documents
    ' and store it in the strMyDocuments folder
    valReturned = SHGetFolderPath(0, CSIDL_PERSONAL, _
                                  0, SHGFP_TYPE_CURRENT, strMyDocuments)
    ' "Trim" the string
    strMyDocuments = Left(strMyDocuments, InStr(1, strMyDocuments, Chr(0)) - 1)
    ' Include the name of the subfolder in the path
    strDbName = strMyDocuments & "\subfolder\"
    
    ' Display the path to the folder in a message box
    MsgBox strDbName



    Dim OpenFile As OPENFILENAME
    Dim lReturn As Long
    Dim sFilter As String
    OpenFile.lStructSize = Len(OpenFile)
    OpenFile.hwndOwner = strform.Hwnd
    sFilter = "CSV Files (*.csv;*.txt)" & Chr(0) & "*.csv;*.txt" & Chr(0) & _
      "All Files (*.*)" & Chr(0) & "*.*" & Chr(0)
    OpenFile.lpstrFilter = sFilter
    OpenFile.nFilterIndex = 1
    OpenFile.lpstrFile = String(257, 0)
    OpenFile.nMaxFile = Len(OpenFile.lpstrFile) - 1
    OpenFile.lpstrFileTitle = OpenFile.lpstrFile
    OpenFile.nMaxFileTitle = OpenFile.nMaxFile
    OpenFile.lpstrInitialDir = strDbName
    OpenFile.lpstrTitle = "Select a file using the Common Dialog DLL"
    OpenFile.flags = 0
    lReturn = GetOpenFileName(OpenFile)
        If lReturn = 0 Then
            MsgBox "A file was not selected!", vbInformation, _
              "Select a file using the Common Dialog DLL"
         Else
            LaunchCD = Trim(Left(OpenFile.lpstrFile, InStr(1, OpenFile.lpstrFile, vbNullChar) - 1))
         End If
End Function

My code might be a bit long, so I'll take a look at yours and see which works most efficiently Thanks again!