[AccessD] Comctl32.ocx

Thanks a lot Stuart, that works great!

-----Original Message-----
From: accessd-bounces at databaseadvisors.com
[mailto:accessd-bounces at databaseadvisors.com] On Behalf Of Stuart McLachlan
Sent: Tuesday, December 21, 2010 10:53 PM
To: Access Developers discussion and problem solving
Subject: Re: [AccessD] Comctl32.ocx

On 21 Dec 2010 at 21:50, John Bartow wrote:

> I've been using the ComDialog control to choose folders and such but 
> it doesn't work with Vista/Windows 7.
> 
> Any suggestions to replace it?

Windows API calls.

Here ya go. It's what I always use instead of the control.   First one for
File selection, second 
for Folder selection.\:

'-----------------------------------
'For files:
'--------------------------------------
Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
         "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long

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 GetFileName(Directory As String) As String
    Dim OpenFile As OPENFILENAME
    Dim lReturn As Long
    Dim sFilter As String
    OpenFile.lStructSize = Len(OpenFile)
    OpenFile.hwndOwner = 0
    OpenFile.hInstance = 0
    sFilter = "" & Chr(0)
    OpenFile.lpstrFilter = sFilter
    OpenFile.nFilterIndex = 0
    OpenFile.lpstrFile = String(257, 0)
    OpenFile.nMaxFile = Len(OpenFile.lpstrFile) - 1
    OpenFile.lpstrFileTitle = OpenFile.lpstrFile
    OpenFile.nMaxFileTitle = OpenFile.nMaxFile
    OpenFile.lpstrInitialDir = Directory
    OpenFile.lpstrTitle = "Select File"
    OpenFile.flags = 0
    lReturn = GetOpenFileName(OpenFile)
    GetFileName = Left$(OpenFile.lpstrFile, InStr(OpenFile.lpstrFile,
Chr$(0)) - 1) End Function

'----------------------------------
'For Folders
'----------------------------------

Option Compare Database
Option Explicit

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

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

Public Type BROWSEINFO    'BI
    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 GetFolder() As String
  Dim pidl As Long
  Dim BI As BROWSEINFO
  Dim sPath As String
  Dim pos As Integer
 
  'Fill BROWSEINFO structure data
   With BI
      .hOwner = 0
      .pidlRoot = 0
      .lpszTitle = "Browsing"
      .ulFlags = 1
      .pszDisplayName = Space$(260)
   End With
  
  'show dialog returning pidl to selected item
   pidl = SHBrowseForFolder(BI)
 
  'if pidl is valid, parse & return the user's selection
   sPath = Space$(260)
    
   If SHGetPathFromIDList(ByVal pidl, ByVal sPath) Then
   
     'SHGetPathFromIDList returns the absolute
     'path to the selected item. No path is returned for virtual folders.
      pos = InStr(sPath, Chr$(0))
      If pos Then GetFolder = Left(sPath, pos - 1)
   Else:
     GetFolder = ""
   End If
 'free the pidl
   Call CoTaskMemFree(pidl)
End Function



--
AccessD mailing list
AccessD at databaseadvisors.com
http://databaseadvisors.com/mailman/listinfo/accessd
Website: http://www.databaseadvisors.com