Solved

Open File Dialog

Posted on 2008-10-27
1
253 Views
Last Modified: 2013-11-27
I use the following code (per Ken Getz et al) for the user to open files contained in a Participant's folder.
When the user opens one file it closes the dialog box. When the user selects muliple files the dialog box remains open. I want it to do the latter (i.e., not close the dialog box when only one file is selected.) Does any one know how to control this?
Public Function fGetDocFiles(strDirectory As String) As Boolean
 
On Error GoTo Err_DocFiles
 
   Dim strDocDirectory As String
   Dim lngFlags As Long
   Dim gfni As adh_accOfficeGetFileNameInfo
   Dim strReturnFile As String
   
   strDocDirectory = strDirectory
   fGetDocFiles = True
  
    On Error Resume Next
    
    If Dir(strDocDirectory) = "" Or IsNull(Dir(strDocDirectory)) Then
        MkDir (strDocDirectory)
    End If
        
    On Error GoTo 0
      
    lngFlags = lngFlags Or adhcGfniConfirmReplace
    lngFlags = lngFlags Or adhcGfniNoChangeDir
    lngFlags = lngFlags Or adhcGfniAllowReadOnly
    lngFlags = lngFlags Or adhcGfniAllowMultiSelect
   ' lngFlags = lngFlags Or adhcGfniDirectoryOnly
    lngFlags = lngFlags Or adhcGfniInitializeView
   
    With gfni
        .lngView = 0
        .lngFlags = lngFlags
        ' Make sure not to pass in Null values. adhOfficeGetFile
        ' doesn't like that, and often GPFs.
        .strFilter = "All Files (*.*)"
        .lngFilterIndex = 1
        .strfile = ""
        .strDlgTitle = "Find Correspondence for " & fGetCaption() & ""
        .strOpenTitle = "Search Docs " & ""
        .strInitialDir = strDocDirectory & ""
    End With
 
    If adhOfficeGetFileName(gfni, True) = adhcAccErrSuccess Then
        strReturnFile = Trim(gfni.strfile)
        Call ShellEx(strReturnFile)
    End If
       
    
 
Exit_DocFiles:
    Exit Function
 
Err_DocFiles:
    msgbox Err.Description
    Resume Exit_DocFiles
    
 
End Function

Open in new window

0
Comment
Question by:bin2003
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
1 Comment
 
LVL 74

Accepted Solution

by:
Jeffrey Coachman earned 500 total points
ID: 22819655
bin2003,

This is the code I use, I found it a while ago on the web.

It leaves the dialog box open when you select one file, as you specified.

'Needed for FileToOpen (Dialog Box) Codes
Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As gFILE) As Long
Type gFILE
 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 FileToOpen(Optional StartLookIn) As String
'*Needs code from Declaratiomns section, in order to work
 Dim OFN As gFILE
 Dim path As String
 Dim FileName As String
 Dim a As String
 
StartOver:
OFN.lStructSize = Len(OFN)
OFN.lpstrFilter = "My Excel Files (*.xls)" + Chr$(0) + "*.xls" + Chr$(0) + "All Files (*.*)" + Chr$(0) + "*.*" + Chr$(0)
OFN.lpstrFile = Space$(254)
OFN.nMaxFile = 255
OFN.lpstrFileTitle = Space$(254)
OFN.nMaxFileTitle = 255

If Not IsMissing(StartLookIn) Then
 OFN.lpstrInitialDir = StartLookIn
'Else
' OFN.lpstrInitialDir = "C:\CorelDrw Files"
End If

OFN.lpstrTitle = "Please find and select the Excel File"
OFN.Flags = 0

a = GetOpenFileName(OFN)
If (a) Then
 path = Trim(OFN.lpstrFile)
 FileName = Trim(OFN.lpstrFileTitle)
 If Dir(path) <> "" Then FileToOpen = -1
 FileToOpen = Trim(OFN.lpstrFile)
Else
 FileToOpen = ""
 path = ""
 FileName = ""
End If

FileToOpen = path

End Function



(I call the function with code like this:
DoCmd.TransferSpreadsheet acImport, 8, strNewTableName, FileToOpen, True, "")

JeffCoachman
0

Featured Post

Comprehensive Backup Solutions for Microsoft

Acronis protects the complete Microsoft technology stack: Windows Server, Windows PC, laptop and Surface data; Microsoft business applications; Microsoft Hyper-V; Azure VMs; Microsoft Windows Server 2016; Microsoft Exchange 2016 and SQL Server 2016.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article describes two methods for creating a combo box that can be used to add new items to the row source -- one for simple lookup tables, and one for a more complex row source where the new item needs data for several fields.
This article describes a method of delivering Word templates for use in merging Access data to Word documents, that requires no computer knowledge on the part of the recipient -- the templates are saved in table fields, and are extracted and install…
With Microsoft Access, learn how to specify relationships between tables and set various options on the relationship. Add the tables: Create the relationship: Decide if you’re going to set referential integrity: Decide if you want cascade upda…
With Microsoft Access, learn how to start a database in different ways and produce different start-up actions allowing you to use a single database to perform multiple tasks. Specify a start-up form through options: Specify an Autoexec macro: Us…

737 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