Browse

[T8JGT]

Is it possible to add a "browse" function to a file path field (text box).

Any Ideas

 

[SiJP]

Yup:

Option Compare Database
Option Explicit


'****************************************************************
' Credits:

http://vbnet.mvps.org/index.html?code/hooks/fileopensavedlghook.htm

'
'****************************************************************


'the open filename api
Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As gFILE) As Long

' the gFILE type needed by the open filename api
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, Optional FilterMDB, Optional strOpenSave) As String
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Purpose: Calls the open file api to let the user select the file
' to open/save
' Returns: String value which contains the path to the file
' selected. "" = no file seleted
' Problems: Cant get the window to get to centre of screen!!!!!
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Dim OFN As gFILE
Dim path As String
Dim filename As String
Dim a As String

StartOver:
OFN.lStructSize = Len(OFN)

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Files to show
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

'Special Codes that can be assigned in functions
Select Case FilterMDB
Case 0
OFN.lpstrFilter = "Office Documents (*.doc, *.xls, *.pdf, etc.)" + Chr$(0) + "*.doc;*.xls;*.mdb; *.pdf" + Chr$(0) + "Text Files (*.txt)" _
+ Chr$(0) + "*.txt" + Chr$(0) + "Rich Text Files (*.rtf)" + Chr$(0) + "*.rtf" + Chr$(0) + "Image Files (*.bmp, *gif, *.jpg, *.jpeg)" + Chr$(0) + "*.bmp;*.gif;*.tif; *.jpg; *.jpeg" + Chr$(0) + "All Files (*.*)" + Chr$(0) + "*.*" + Chr$(0)
Case 1
OFN.lpstrFilter = "MS Access Databases (*.mdb)" + Chr$(0) + "*.mdb"
Case 2
OFN.lpstrFilter = "Excel Spreadsheet (*.xls)" + Chr$(0) + "*.xls"
Case 3
OFN.lpstrFilter = "HTML Document (*.html)" + Chr$(0) + "*.html"
End Select

OFN.lpstrFile = Space$(254)

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:\some default directory"
End If

Select Case strOpenSave
Case "Open"
OFN.lpstrTitle = "Select File to Add to Database"
Case "Save"
OFN.lpstrTitle = "Select Location to Save Export"
End Select

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

------------------------
Hit any User to continue