Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations IamaSherpa on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Dialog Box to return a file path

Status
Not open for further replies.

Jdick

Programmer
Mar 18, 2005
2
CA
Hi, I have to reprogram a macro in the Extra environment that was originaly programmed in the Aviva environment. In Aviva macro editor, I was using a function named Openfilename.

here is the description of the function:
Displays a dialog box that prompts the user to select from a list of files, returning the full pathname of the file the user selects or a zero-length string if the user selects Cancel.

Is there any similar function in Extra?
 
I found this a couple months ago when looking through the forums. It's worked great for me.

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

Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenFileName As OPENFILENAME) As Long
Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long

Dim pOpenFileName As OPENFILENAME
Global Const OFN_READONLY = &H1
Global Const OFN_OVERWRITEPROMPT = &H2
Global Const OFN_HIDEREADONLY = &H4
Global Const OFN_NOCHANGEDIR = &H8
Global Const OFN_SHOWHELP = &H10
Global Const OFN_ENABLEHOOK = &H20
Global Const OFN_ENABLETEMPLATE = &H40
Global Const OFN_ENABLETEMPLATEHANDLE = &H80
Global Const OFN_NOVALIDATE = &H100
Global Const OFN_ALLOWMULTISELECT = &H200
Global Const OFN_EXTENSIONDIFFERENT = &H400
Global Const OFN_PATHMUSTEXIST = &H800
Global Const OFN_FILEMUSTEXIST = &H1000
Global Const OFN_CREATEPROMPT = &H2000
Global Const OFN_SHAREAWARE = &H4000
Global Const OFN_NOREADONLYRETURN = &H8000
Global Const OFN_NOTESTFILECREATE = &H10000
Global Const OFN_SHAREFALLTHROUGH = 2
Global Const OFN_SHARENOWARN = 1
Global Const OFN_SHAREWARN = 0

' Open File Dialog
Function GetFileName(Title$, FileType$) As String
  Dim Message$, Filter$, FileName$, FileTitle$, DefExt$
  Dim szCurDir$, APIResults&

    ' Define the filter string and allocate space in the "c" string
    Filter$ = "Type of File (*." & FileType & ")" & Chr(0) & "*." & FileType & Chr(0)
    Filter$ = Filter$ & "All Files (*.*)" & Chr(0) & "*.*" & Chr(0)
    Filter$ = Filter$ & Chr(0)

    ' Allocate string space for the returned strings.
    FileName$ = Chr(0) & Space(255) & Chr(0)
    FileTitle$ = Space(255) & Chr(0)

    ' Give the dialog a caption title.
    Title$ = Title$ & Chr(0)

    ' If the user does not specify an extension, append MDB.
    DefExt$ = "txt" & Chr(0)

    ' Set up the defualt directory
    szCurDir$ = CurDir$ & Chr(0)

    ' Set up the data structure before you call the GetOpenFileName
    pOpenFileName.lStructSize = Len(pOpenFileName)
    pOpenFileName.hwndOwner = GetModuleHandle("Extra.exe")
    pOpenFileName.lpstrFilter = lstrcpy(Filter$, Filter$)
    pOpenFileName.nFilterIndex = 1
    pOpenFileName.lpstrFile = lstrcpy(FileName$, FileName$)
    pOpenFileName.nMaxFile = Len(FileName$)
    pOpenFileName.lpstrFileTitle = lstrcpy(FileTitle$, FileTitle$)
    pOpenFileName.nMaxFileTitle = Len(FileTitle$)
    pOpenFileName.lpstrTitle = lstrcpy(Title$, Title$)
    pOpenFileName.Flags = OFN_HIDEREADONLY + OFN_FILEMUSTEXIST
    pOpenFileName.lpstrDefExt = lstrcpy(DefExt$, DefExt$)
    pOpenFileName.hInstance = 0
    pOpenFileName.lpstrCustomFilter = 0
    pOpenFileName.nMaxCustFilter = 0
    pOpenFileName.lpstrInitialDir = lstrcpy(szCurDir$, szCurDir$)
    pOpenFileName.nFileOffset = 0
    pOpenFileName.nFileExtension = 0
    pOpenFileName.lCustData = 0
    pOpenFileName.lpfnHook = 0
    pOpenFileName.lpTemplateName = 0

    ' This will pass the desired data structure to the Windows API,
    ' which will in turn use it to display the Open Dialog form.

    APIResults& = GetOpenFileName(pOpenFileName)

    If APIResults& <> 0 Then
        GetFileName = Trim(FileName$)
    Else
        'return null string if no file selected
        GetFileName = ""
    End If

End Function

Sub Main
File2Open = GetFileName("Text File", "TXT")
End Sub
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top