ExcelBanter - GetOpenFilename - How can you filter files starting with a letter...

ExcelBanter (https://www.excelbanter.com/)

- Excel Programming (https://www.excelbanter.com/excel-programming/)

- - GetOpenFilename - How can you filter files starting with a letter... (https://www.excelbanter.com/excel-programming/295853-getopenfilename-how-can-you-filter-files-starting-letter.html)

GetOpenFilename - How can you filter files starting with a letter...

I am using the following code to open an .rtf document. I'd like th
dialog box to be able to show files that start with the number '200003
only. Is this possible please?

FileToOpen = Application.GetOpenFilename("rtf Files (*.rtf),*.rtf")

I've tried lots of different ways but just can't figure it out. I'v
also spent a few hours trying to find an example but to no avail.

Any help would be much appreciated.

TIA

Red

--
Message posted from http://www.ExcelForum.com

GetOpenFilename - How can you filter files starting with a letter...

Hi

Type 200003* and press Enter in The File Name box

--
Regards Ron de Bruin
http://www.rondebruin.nl

"rede96 " wrote in message ...
I am using the following code to open an .rtf document. I'd like the
dialog box to be able to show files that start with the number '200003'
only. Is this possible please?

FileToOpen = Application.GetOpenFilename("rtf Files (*.rtf),*.rtf")

I've tried lots of different ways but just can't figure it out. I've
also spent a few hours trying to find an example but to no avail.

Any help would be much appreciated.

TIA

Red.

---
Message posted from http://www.ExcelForum.com/

GetOpenFilename - How can you filter files starting with a letter...

Hi,

I'll try and play around with both those methods and see what I ca
come up with. I think once I've got the file names, I'll put them int
a list box and filter.

Thanks.

Re

--
Message posted from http://www.ExcelForum.com

GetOpenFilename - How can you filter files starting with a letter...

No, you need an API for that. I have implemented it as a class, which is
given below.

Here is an example of using that class, just set the properties as you wish

Sub OpenFiles()
Dim cFileOpen As clsGetOpenFileName

Set cFileOpen = New clsGetOpenFileName

With cFileOpen

.FileName = "Ex*.xls"
.FileType = "Excel Files"
.DialogTitle = "Class File Browser Demo"
.MultiFile = "N"
.SelectFile

If .SelectedFiles.Count 0 Then
MsgBox (.SelectedFiles(1))
End If

End With

Set cFileOpen = Nothing

End Sub

'Class file - named clsGetOIpenFileName

Option Explicit

'---------------------------------------------------------------------------
' Win32 API Declarations
'---------------------------------------------------------------------------
Private Declare Function GetOpenFilename Lib "comdlg32.dll" _
Alias "GetOpenFileNameA" _
(pOpenfilename As OPENFILENAME) As Long

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

Private Declare Function GetShortPathName Lib "kernel32" _
Alias "GetShortPathNameA" _
(ByVal lpszLongPath As String, _
ByVal lpszShortPath As String, _
ByVal cchBuffer As Long) As Long

Private Type OPENFILENAME
nStructSize As Long
hWndOwner As Long
hInstance As Long
sFilter As String
sCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
sFile As String
nMaxFile As Long
sFileTitle As String
nMaxTitle As Long
sInitialDir As String
sDialogTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
sDefFileExt As String
nCustData As Long
fnHook As Long
sTemplateName As String
End Type

'---------------------------------------------------------------------------
' Private Variables
'---------------------------------------------------------------------------
Private OFN As OPENFILENAME

Private sFileType As String 'Type of file narrative
Private sFileName As String 'Filename string to restrict list
Private sReadOnly As String 'Y/N flag
Private sMultiFile As String 'Allow selection of multiple files
Private sTitle As String 'Title in file dialog box

'---------------------------------------------------------------------------
' Private Constants
'---------------------------------------------------------------------------
Private Const OFN_ALLOWMULTISELECT As Long = &H200
Private Const OFN_CREATEPROMPT As Long = &H2000
Private Const OFN_ENABLEHOOK As Long = &H20
Private Const OFN_ENABLETEMPLATE As Long = &H40
Private Const OFN_ENABLETEMPLATEHANDLE As Long = &H80
Private Const OFN_EXPLORER As Long = &H80000
Private Const OFN_EXTENSIONDIFFERENT As Long = &H400
Private Const OFN_FILEMUSTEXIST As Long = &H1000
Private Const OFN_HIDEREADONLY As Long = &H4
Private Const OFN_LONGNAMES As Long = &H200000
Private Const OFN_NOCHANGEDIR As Long = &H8
Private Const OFN_NODEREFERENCELINKS As Long = &H100000
Private Const OFN_NOLONGNAMES As Long = &H40000
Private Const OFN_NONETWORKBUTTON As Long = &H20000
Private Const OFN_NOREADONLYRETURN As Long = &H8000& '*see comments
Private Const OFN_NOTESTFILECREATE As Long = &H10000
Private Const OFN_NOVALIDATE As Long = &H100
Private Const OFN_OVERWRITEPROMPT As Long = &H2
Private Const OFN_PATHMUSTEXIST As Long = &H800
Private Const OFN_READONLY As Long = &H1
Private Const OFN_SHAREAWARE As Long = &H4000
Private Const OFN_SHAREFALLTHROUGH As Long = 2
Private Const OFN_SHAREWARN As Long = 0
Private Const OFN_SHARENOWARN As Long = 1
Private Const OFN_SHOWHELP As Long = &H10
Private Const OFS_MAXPATHNAME As Long = 260

'OFS_FILE_OPEN_FLAGS and OFS_FILE_SAVE_FLAGS below are mine to save long
'statements; they're not a standard Win32 type.
Private Const OFS_FILE_OPEN_FLAGS = OFN_EXPLORER Or _
OFN_LONGNAMES Or _
OFN_CREATEPROMPT Or _
OFN_NODEREFERENCELINKS

Private Const OFS_FILE_SAVE_FLAGS = OFN_EXPLORER Or _
OFN_LONGNAMES Or _
OFN_OVERWRITEPROMPT Or _
OFN_HIDEREADONLY

'-------------------------------------------------------------
' Class Properties
'-------------------------------------------------------------
Public SelectedFiles As New Collection

Public Property Let FileType(FileType As String)
sFileType = FileType
End Property

Public Property Let FileName(FileName As String)
sFileName = FileName
End Property

Public Property Let MultiFile(MultiFile As String)
sMultiFile = UCase(MultiFile)
End Property

Public Property Let DialogTitle(Title As String)
sTitle = Title
End Property

Public Property Get ReadOnly()
ReadOnly = sReadOnly
End Property

'-------------------------------------------------------------
' Class Methods
'-------------------------------------------------------------
Public Function SelectFile() As Long
'-------------------------------------------------------------
Dim i
Dim sFilters As String
Dim sBuffer As String
Dim sLongname As String
Dim sShortname As String

If ValidInput Then
'create a string of filters for the dialog
sFilters = sFileType & vbNullChar & vbNullChar

With OFN

.nStructSize = Len(OFN) 'Size of the OFN structure
.sFilter = sFilters 'Filters for the dropdown combo
.nFilterIndex = 1 'Index to the initial filter

'Default filename, plus additional padding for user'
s final
' selection(s). Must be double-null terminated
.sFile = sFileName & Space$(1024) & vbNullChar & vbNullChar

.nMaxFile = Len(.sFile) 'the size of the buffer
'Default if file has no extension
.sDefFileExt = sFileName & vbNullChar & vbNullChar
'Make space for file title if single selection made,
' double-null terminated, and its size
.sFileTitle = vbNullChar & Space$(512) & _
vbNullChar & vbNullChar
.nMaxTitle = Len(OFN.sFileTitle)
'Starting folder, double-null terminated
.sInitialDir = ThisWorkbook.Path & vbNullChar

.sDialogTitle = sTitle 'the dialog title string

'Default open flags and multiselect
.flags = OFS_FILE_OPEN_FLAGS Or _
OFN_NOCHANGEDIR

If sMultiFile = "Y" Then .flags = .flags Or _
OFN_ALLOWMULTISELECT

End With

SelectFile = GetOpenFilename(OFN)
If SelectFile Then
'Remove trailing pair of terminating nulls and
' trim returned file string
sBuffer = Trim$(Left$(OFN.sFile, Len(OFN.sFile) - 2))
'If multiple- select, first member is path,
remaining
' members are the files under that path
Do While Len(sBuffer) 3
SelectedFiles.Add StripDelimitedItem(sBuffer,
vbNullChar)
Loop

sReadOnly = Abs((OFN.flags And OFN_READONLY))

End If
End If

End Function

Private Sub Class_Initialize()
sTitle = "GetOpenFileName"
End Sub

Private Sub Class_Terminate()
Set SelectedFiles = Nothing
End Sub

'-----------------------------------------------------------------
Private Function ValidInput() As Boolean
'-----------------------------------------------------------------
Dim i As Integer

ValidInput = True

i = 1
If IsEmpty(sFileName) Then
sFileName = " - a file description must be supplied"
i = i + 1
ValidInput = False
End If

If IsEmpty(sFileType) Then
sFileType = " - a file extension must be supplied"
i = i + 1
ValidInput = False
End If

If sMultiFile < "Y" And sMultiFile < "N" Then
sMultiFile = "Multiple files must be Y or N"
i = i + 1
ValidInput = False
End If

End Function

'-----------------------------------------------------------------
Private Function StripDelimitedItem(startStrg As String, _
delimiter As String) As String
'-----------------------------------------------------------------
'take a string separated by nulls, split off 1 item, and shorten
' the string so the next item is ready for removal.
'-----------------------------------------------------------------
Dim pos As Long
Dim item As String

pos = InStr(1, startStrg, delimiter)

If pos Then
StripDelimitedItem = Mid$(startStrg, 1, pos)
startStrg = Mid$(startStrg, pos + 1, Len(startStrg))
End If

End Function

'-----------------------------------------------------------------
Private Function TrimNull(item As String) As String
'-----------------------------------------------------------------
Dim pos As Integer

pos = InStr(item, Chr$(0))
TrimNull = IIf(pos, Left$(item, pos - 1), item)

End Function

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

"rede96 " wrote in message
...
I am using the following code to open an .rtf document. I'd like the
dialog box to be able to show files that start with the number '200003'
only. Is this possible please?

FileToOpen = Application.GetOpenFilename("rtf Files (*.rtf),*.rtf")

I've tried lots of different ways but just can't figure it out. I've
also spent a few hours trying to find an example but to no avail.

Any help would be much appreciated.

TIA

Red.

---
Message posted from http://www.ExcelForum.com/

GetOpenFilename - How can you filter files starting with a letter...

I think I use this then Bob
Easier for a flower grower<g

Type 200003* and press Enter in The File Name box

--
Regards Ron de Bruin
http://www.rondebruin.nl

"Bob Phillips" wrote in message ...
No, you need an API for that. I have implemented it as a class, which is
given below.

Here is an example of using that class, just set the properties as you wish

Sub OpenFiles()
Dim cFileOpen As clsGetOpenFileName

Set cFileOpen = New clsGetOpenFileName

With cFileOpen

.FileName = "Ex*.xls"
.FileType = "Excel Files"
.DialogTitle = "Class File Browser Demo"
.MultiFile = "N"
.SelectFile

If .SelectedFiles.Count 0 Then
MsgBox (.SelectedFiles(1))
End If

End With

Set cFileOpen = Nothing

End Sub

'Class file - named clsGetOIpenFileName

Option Explicit

'---------------------------------------------------------------------------
' Win32 API Declarations
'---------------------------------------------------------------------------
Private Declare Function GetOpenFilename Lib "comdlg32.dll" _
Alias "GetOpenFileNameA" _
(pOpenfilename As OPENFILENAME) As Long

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

Private Declare Function GetShortPathName Lib "kernel32" _
Alias "GetShortPathNameA" _
(ByVal lpszLongPath As String, _
ByVal lpszShortPath As String, _
ByVal cchBuffer As Long) As Long

Private Type OPENFILENAME
nStructSize As Long
hWndOwner As Long
hInstance As Long
sFilter As String
sCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
sFile As String
nMaxFile As Long
sFileTitle As String
nMaxTitle As Long
sInitialDir As String
sDialogTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
sDefFileExt As String
nCustData As Long
fnHook As Long
sTemplateName As String
End Type

'---------------------------------------------------------------------------
' Private Variables
'---------------------------------------------------------------------------
Private OFN As OPENFILENAME

Private sFileType As String 'Type of file narrative
Private sFileName As String 'Filename string to restrict list
Private sReadOnly As String 'Y/N flag
Private sMultiFile As String 'Allow selection of multiple files
Private sTitle As String 'Title in file dialog box

'---------------------------------------------------------------------------
' Private Constants
'---------------------------------------------------------------------------
Private Const OFN_ALLOWMULTISELECT As Long = &H200
Private Const OFN_CREATEPROMPT As Long = &H2000
Private Const OFN_ENABLEHOOK As Long = &H20
Private Const OFN_ENABLETEMPLATE As Long = &H40
Private Const OFN_ENABLETEMPLATEHANDLE As Long = &H80
Private Const OFN_EXPLORER As Long = &H80000
Private Const OFN_EXTENSIONDIFFERENT As Long = &H400
Private Const OFN_FILEMUSTEXIST As Long = &H1000
Private Const OFN_HIDEREADONLY As Long = &H4
Private Const OFN_LONGNAMES As Long = &H200000
Private Const OFN_NOCHANGEDIR As Long = &H8
Private Const OFN_NODEREFERENCELINKS As Long = &H100000
Private Const OFN_NOLONGNAMES As Long = &H40000
Private Const OFN_NONETWORKBUTTON As Long = &H20000
Private Const OFN_NOREADONLYRETURN As Long = &H8000& '*see comments
Private Const OFN_NOTESTFILECREATE As Long = &H10000
Private Const OFN_NOVALIDATE As Long = &H100
Private Const OFN_OVERWRITEPROMPT As Long = &H2
Private Const OFN_PATHMUSTEXIST As Long = &H800
Private Const OFN_READONLY As Long = &H1
Private Const OFN_SHAREAWARE As Long = &H4000
Private Const OFN_SHAREFALLTHROUGH As Long = 2
Private Const OFN_SHAREWARN As Long = 0
Private Const OFN_SHARENOWARN As Long = 1
Private Const OFN_SHOWHELP As Long = &H10
Private Const OFS_MAXPATHNAME As Long = 260

'OFS_FILE_OPEN_FLAGS and OFS_FILE_SAVE_FLAGS below are mine to save long
'statements; they're not a standard Win32 type.
Private Const OFS_FILE_OPEN_FLAGS = OFN_EXPLORER Or _
OFN_LONGNAMES Or _
OFN_CREATEPROMPT Or _
OFN_NODEREFERENCELINKS

Private Const OFS_FILE_SAVE_FLAGS = OFN_EXPLORER Or _
OFN_LONGNAMES Or _
OFN_OVERWRITEPROMPT Or _
OFN_HIDEREADONLY

'-------------------------------------------------------------
' Class Properties
'-------------------------------------------------------------
Public SelectedFiles As New Collection

Public Property Let FileType(FileType As String)
sFileType = FileType
End Property

Public Property Let FileName(FileName As String)
sFileName = FileName
End Property

Public Property Let MultiFile(MultiFile As String)
sMultiFile = UCase(MultiFile)
End Property

Public Property Let DialogTitle(Title As String)
sTitle = Title
End Property

Public Property Get ReadOnly()
ReadOnly = sReadOnly
End Property

'-------------------------------------------------------------
' Class Methods
'-------------------------------------------------------------
Public Function SelectFile() As Long
'-------------------------------------------------------------
Dim i
Dim sFilters As String
Dim sBuffer As String
Dim sLongname As String
Dim sShortname As String

If ValidInput Then
'create a string of filters for the dialog
sFilters = sFileType & vbNullChar & vbNullChar

With OFN

.nStructSize = Len(OFN) 'Size of the OFN structure
.sFilter = sFilters 'Filters for the dropdown combo
.nFilterIndex = 1 'Index to the initial filter

'Default filename, plus additional padding for user'
s final
' selection(s). Must be double-null terminated
.sFile = sFileName & Space$(1024) & vbNullChar & vbNullChar

.nMaxFile = Len(.sFile) 'the size of the buffer
'Default if file has no extension
.sDefFileExt = sFileName & vbNullChar & vbNullChar
'Make space for file title if single selection made,
' double-null terminated, and its size
.sFileTitle = vbNullChar & Space$(512) & _
vbNullChar & vbNullChar
.nMaxTitle = Len(OFN.sFileTitle)
'Starting folder, double-null terminated
.sInitialDir = ThisWorkbook.Path & vbNullChar

.sDialogTitle = sTitle 'the dialog title string

'Default open flags and multiselect
.flags = OFS_FILE_OPEN_FLAGS Or _
OFN_NOCHANGEDIR

If sMultiFile = "Y" Then .flags = .flags Or _
OFN_ALLOWMULTISELECT

End With

SelectFile = GetOpenFilename(OFN)
If SelectFile Then
'Remove trailing pair of terminating nulls and
' trim returned file string
sBuffer = Trim$(Left$(OFN.sFile, Len(OFN.sFile) - 2))
'If multiple- select, first member is path,
remaining
' members are the files under that path
Do While Len(sBuffer) 3
SelectedFiles.Add StripDelimitedItem(sBuffer,
vbNullChar)
Loop

sReadOnly = Abs((OFN.flags And OFN_READONLY))

End If
End If

End Function

Private Sub Class_Initialize()
sTitle = "GetOpenFileName"
End Sub

Private Sub Class_Terminate()
Set SelectedFiles = Nothing
End Sub

'-----------------------------------------------------------------
Private Function ValidInput() As Boolean
'-----------------------------------------------------------------
Dim i As Integer

ValidInput = True

i = 1
If IsEmpty(sFileName) Then
sFileName = " - a file description must be supplied"
i = i + 1
ValidInput = False
End If

If IsEmpty(sFileType) Then
sFileType = " - a file extension must be supplied"
i = i + 1
ValidInput = False
End If

If sMultiFile < "Y" And sMultiFile < "N" Then
sMultiFile = "Multiple files must be Y or N"
i = i + 1
ValidInput = False
End If

End Function

'-----------------------------------------------------------------
Private Function StripDelimitedItem(startStrg As String, _
delimiter As String) As String
'-----------------------------------------------------------------
'take a string separated by nulls, split off 1 item, and shorten
' the string so the next item is ready for removal.
'-----------------------------------------------------------------
Dim pos As Long
Dim item As String

pos = InStr(1, startStrg, delimiter)

If pos Then
StripDelimitedItem = Mid$(startStrg, 1, pos)
startStrg = Mid$(startStrg, pos + 1, Len(startStrg))
End If

End Function

'-----------------------------------------------------------------
Private Function TrimNull(item As String) As String
'-----------------------------------------------------------------
Dim pos As Integer

pos = InStr(item, Chr$(0))
TrimNull = IIf(pos, Left$(item, pos - 1), item)

End Function

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

"rede96 " wrote in message
...
I am using the following code to open an .rtf document. I'd like the
dialog box to be able to show files that start with the number '200003'
only. Is this possible please?

FileToOpen = Application.GetOpenFilename("rtf Files (*.rtf),*.rtf")

I've tried lots of different ways but just can't figure it out. I've
also spent a few hours trying to find an example but to no avail.

Any help would be much appreciated.

TIA

Red.

---
Message posted from http://www.ExcelForum.com/

GetOpenFilename - How can you filter files starting with a letter...

and it uses APIs<vbg

Bob

"Ron de Bruin" wrote in message
...
I think I use this then Bob
Easier for a flower grower<g

Type 200003* and press Enter in The File Name box

--
Regards Ron de Bruin
http://www.rondebruin.nl

"Bob Phillips" wrote in message
...
No, you need an API for that. I have implemented it as a class, which is
given below.

Here is an example of using that class, just set the properties as you
wish

Sub OpenFiles()
Dim cFileOpen As clsGetOpenFileName

Set cFileOpen = New clsGetOpenFileName

With cFileOpen

.FileName = "Ex*.xls"
.FileType = "Excel Files"
.DialogTitle = "Class File Browser Demo"
.MultiFile = "N"
.SelectFile

If .SelectedFiles.Count 0 Then
MsgBox (.SelectedFiles(1))
End If

End With

Set cFileOpen = Nothing

End Sub

'Class file - named clsGetOIpenFileName

Option Explicit

'---------------------------------------------------------------------------
' Win32 API Declarations

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

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

Private Declare Function GetShortPathName Lib "kernel32" _
Alias "GetShortPathNameA" _
(ByVal lpszLongPath As String, _
ByVal lpszShortPath As String, _
ByVal cchBuffer As Long) As Long

Private Type OPENFILENAME
nStructSize As Long
hWndOwner As Long
hInstance As Long
sFilter As String
sCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
sFile As String
nMaxFile As Long
sFileTitle As String
nMaxTitle As Long
sInitialDir As String
sDialogTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
sDefFileExt As String
nCustData As Long
fnHook As Long
sTemplateName As String
End Type

'---------------------------------------------------------------------------
' Private Variables

'---------------------------------------------------------------------------
Private OFN As OPENFILENAME

Private sFileType As String 'Type of file narrative
Private sFileName As String 'Filename string to restrict list
Private sReadOnly As String 'Y/N flag
Private sMultiFile As String 'Allow selection of multiple files
Private sTitle As String 'Title in file dialog box

'---------------------------------------------------------------------------
' Private Constants

'---------------------------------------------------------------------------
Private Const OFN_ALLOWMULTISELECT As Long = &H200
Private Const OFN_CREATEPROMPT As Long = &H2000
Private Const OFN_ENABLEHOOK As Long = &H20
Private Const OFN_ENABLETEMPLATE As Long = &H40
Private Const OFN_ENABLETEMPLATEHANDLE As Long = &H80
Private Const OFN_EXPLORER As Long = &H80000
Private Const OFN_EXTENSIONDIFFERENT As Long = &H400
Private Const OFN_FILEMUSTEXIST As Long = &H1000
Private Const OFN_HIDEREADONLY As Long = &H4
Private Const OFN_LONGNAMES As Long = &H200000
Private Const OFN_NOCHANGEDIR As Long = &H8
Private Const OFN_NODEREFERENCELINKS As Long = &H100000
Private Const OFN_NOLONGNAMES As Long = &H40000
Private Const OFN_NONETWORKBUTTON As Long = &H20000
Private Const OFN_NOREADONLYRETURN As Long = &H8000& '*see comments
Private Const OFN_NOTESTFILECREATE As Long = &H10000
Private Const OFN_NOVALIDATE As Long = &H100
Private Const OFN_OVERWRITEPROMPT As Long = &H2
Private Const OFN_PATHMUSTEXIST As Long = &H800
Private Const OFN_READONLY As Long = &H1
Private Const OFN_SHAREAWARE As Long = &H4000
Private Const OFN_SHAREFALLTHROUGH As Long = 2
Private Const OFN_SHAREWARN As Long = 0
Private Const OFN_SHARENOWARN As Long = 1
Private Const OFN_SHOWHELP As Long = &H10
Private Const OFS_MAXPATHNAME As Long = 260

'OFS_FILE_OPEN_FLAGS and OFS_FILE_SAVE_FLAGS below are mine to save long
'statements; they're not a standard Win32 type.
Private Const OFS_FILE_OPEN_FLAGS = OFN_EXPLORER Or _
OFN_LONGNAMES Or _
OFN_CREATEPROMPT Or _
OFN_NODEREFERENCELINKS

Private Const OFS_FILE_SAVE_FLAGS = OFN_EXPLORER Or _
OFN_LONGNAMES Or _
OFN_OVERWRITEPROMPT Or _
OFN_HIDEREADONLY

'-------------------------------------------------------------
' Class Properties
'-------------------------------------------------------------
Public SelectedFiles As New Collection

Public Property Let FileType(FileType As String)
sFileType = FileType
End Property

Public Property Let FileName(FileName As String)
sFileName = FileName
End Property

Public Property Let MultiFile(MultiFile As String)
sMultiFile = UCase(MultiFile)
End Property

Public Property Let DialogTitle(Title As String)
sTitle = Title
End Property

Public Property Get ReadOnly()
ReadOnly = sReadOnly
End Property

'-------------------------------------------------------------
' Class Methods
'-------------------------------------------------------------
Public Function SelectFile() As Long
'-------------------------------------------------------------
Dim i
Dim sFilters As String
Dim sBuffer As String
Dim sLongname As String
Dim sShortname As String

If ValidInput Then
'create a string of filters for the dialog
sFilters = sFileType & vbNullChar & vbNullChar

With OFN

.nStructSize = Len(OFN) 'Size of the OFN
structure
.sFilter = sFilters 'Filters for the dropdown combo
.nFilterIndex = 1 'Index to the initial filter

'Default filename, plus additional padding for
user'
s final
' selection(s). Must be double-null terminated
.sFile = sFileName & Space$(1024) & vbNullChar &
vbNullChar

.nMaxFile = Len(.sFile) 'the size of the buffer
'Default if file has no extension
.sDefFileExt = sFileName & vbNullChar & vbNullChar
'Make space for file title if single selection
made,
' double-null terminated, and its size
.sFileTitle = vbNullChar & Space$(512) & _
vbNullChar & vbNullChar
.nMaxTitle = Len(OFN.sFileTitle)
'Starting folder, double-null terminated
.sInitialDir = ThisWorkbook.Path & vbNullChar

.sDialogTitle = sTitle 'the dialog title
string

'Default open flags and multiselect
.flags = OFS_FILE_OPEN_FLAGS Or _
OFN_NOCHANGEDIR

If sMultiFile = "Y" Then .flags = .flags Or _
OFN_ALLOWMULTISELECT

End With

SelectFile = GetOpenFilename(OFN)
If SelectFile Then
'Remove trailing pair of terminating nulls and
' trim returned file string
sBuffer = Trim$(Left$(OFN.sFile, Len(OFN.sFile) - 2))
'If multiple- select, first member is path,
remaining
' members are the files under that path
Do While Len(sBuffer) 3
SelectedFiles.Add StripDelimitedItem(sBuffer,
vbNullChar)
Loop

sReadOnly = Abs((OFN.flags And OFN_READONLY))

End If
End If

End Function

Private Sub Class_Initialize()
sTitle = "GetOpenFileName"
End Sub

Private Sub Class_Terminate()
Set SelectedFiles = Nothing
End Sub

'-----------------------------------------------------------------
Private Function ValidInput() As Boolean
'-----------------------------------------------------------------
Dim i As Integer

ValidInput = True

i = 1
If IsEmpty(sFileName) Then
sFileName = " - a file description must be supplied"
i = i + 1
ValidInput = False
End If

If IsEmpty(sFileType) Then
sFileType = " - a file extension must be supplied"
i = i + 1
ValidInput = False
End If

If sMultiFile < "Y" And sMultiFile < "N" Then
sMultiFile = "Multiple files must be Y or N"
i = i + 1
ValidInput = False
End If

End Function

'-----------------------------------------------------------------
Private Function StripDelimitedItem(startStrg As String, _
delimiter As String) As String
'-----------------------------------------------------------------
'take a string separated by nulls, split off 1 item, and shorten
' the string so the next item is ready for removal.
'-----------------------------------------------------------------
Dim pos As Long
Dim item As String

pos = InStr(1, startStrg, delimiter)

If pos Then
StripDelimitedItem = Mid$(startStrg, 1, pos)
startStrg = Mid$(startStrg, pos + 1, Len(startStrg))
End If

End Function

'-----------------------------------------------------------------
Private Function TrimNull(item As String) As String
'-----------------------------------------------------------------
Dim pos As Integer

pos = InStr(item, Chr$(0))
TrimNull = IIf(pos, Left$(item, pos - 1), item)

End Function

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

"rede96 " wrote in message
...
I am using the following code to open an .rtf document. I'd like the
dialog box to be able to show files that start with the number
'200003'
only. Is this possible please?

FileToOpen = Application.GetOpenFilename("rtf Files (*.rtf),*.rtf")

I've tried lots of different ways but just can't figure it out. I've
also spent a few hours trying to find an example but to no avail.

Any help would be much appreciated.

TIA

Red.

---
Message posted from http://www.ExcelForum.com/

GetOpenFilename - How can you filter files starting with a letter...

Hi Bob,

Thanks for that. I don't wish to seem ungrateful however I'm still onl
a beginner when it comes to programming. I only mess about in VBA an
to be honest I don't really understand what your code does or what t
do with it!

I put it in a module in excel however it doesn't compile.

Sorry to pain but could you explain it a little more for me? More t
the point what do I need to do with it!

Appreciate your time Bob, thanks

Red

--
Message posted from http://www.ExcelForum.com

GetOpenFilename - How can you filter files starting with a letter...

Red,

It's a bit complex if you are a beginner. If you sent me your email address,
I will send you a workbook example.

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

"rede96 " wrote in message
...
Hi Bob,

Thanks for that. I don't wish to seem ungrateful however I'm still only
a beginner when it comes to programming. I only mess about in VBA and
to be honest I don't really understand what your code does or what to
do with it!

I put it in a module in excel however it doesn't compile.

Sorry to pain but could you explain it a little more for me? More to
the point what do I need to do with it!

Appreciate your time Bob, thanks

Red.

---
Message posted from http://www.ExcelForum.com/

GetOpenFilename - How can you filter files starting with a letter...

Perhaps this will explain it a little

http://www.xcelfiles.com/comdlg.html

rede96 wrote in message ...
Hi Bob,

Thanks for that. I don't wish to seem ungrateful however I'm still only
a beginner when it comes to programming. I only mess about in VBA and
to be honest I don't really understand what your code does or what to
do with it!

I put it in a module in excel however it doesn't compile.

Sorry to pain but could you explain it a little more for me? More to
the point what do I need to do with it!

Appreciate your time Bob, thanks

Red.

---
Message posted from http://www.ExcelForum.com/

GetOpenFilename - How can you filter files starting with a letter...

It's in the post.

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

"rede96 " wrote in message
...
Hi Bob,

You can email me at . Thanks again for your help.

Red

---
Message posted from http://www.ExcelForum.com/