Hi All,

I am using the following construct to select files......., which works
great.

xFile = Application.GetOpenFilename("ARTS_Daily (*.xls), *.xls", 1,
"Choose File", "", False)

I have a need to filter not just the file extension as in *.xls but also the
filename eg ... ARTS*.xls, to give all xls files beginning with ARTS.
Something like.....

xFile = Application.GetOpenFilename("ARTS_Daily (ARTS*.xls), ARTS*.xls",
1, "Choose File", "", False)

However this does not work as expected, with the dialog defaulting the
filter to All files *.*

Any ideas anyone on how best to achieve this?

--
Cheers
Nigel

The you need the API.

use a version encapsulated in a class module, attached below. To use it,
add this code to a class module, call it clsGetOpenFileName, and invoke it
is the following way

Dim cFileOpen As clsGetOpenFileName


Set cFileOpen = New clsGetOpenFileName


With cFileOpen
.FileName = "Ex*.xls"
.FileType = "Excel Files"
.DialogTitle = "Class GetOpenFileName Demo"
.MultiFile = "N"
.SelectFile


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


Set cFileOpen = Nothing


Other code is after my signature




--

HTH

RP
(remove nothere from the email address if mailing direct)



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
.nFilterIndex = 1 'Index to the initial filter

.sFile = sFileName & Space$(1024) & vbNullChar & vbNullChar

.nMaxFile = Len(.sFile)
.sDefFileExt = sFileName & vbNullChar & vbNullChar
.sFileTitle = vbNullChar & Space$(512) & _
vbNullChar & vbNullChar
.nMaxTitle = Len(OFN.sFileTitle)
.sInitialDir = ThisWorkbook.Path & vbNullChar

.sDialogTitle = sTitle

.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 the 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))
If pos Then
TrimNull = Left$(item, pos - 1)
Else
TrimNull = item
End If

End Function



"Nigel" wrote in message
...
Hi All,

I am using the following construct to select files......., which works
great.

xFile = Application.GetOpenFilename("ARTS_Daily (*.xls), *.xls", 1,
"Choose File", "", False)

I have a need to filter not just the file extension as in *.xls but also
the
filename eg ... ARTS*.xls, to give all xls files beginning with ARTS.
Something like.....

xFile = Application.GetOpenFilename("ARTS_Daily (ARTS*.xls),
ARTS*.xls",
1, "Choose File", "", False)

However this does not work as expected, with the dialog defaulting the
filter to All files *.*

Any ideas anyone on how best to achieve this?

--
Cheers
Nigel

Hi Bob,
Wow! I have tried it but I have a problem.
I created the class module and pasted your code, named it
clsGetOpenFileName, I run the call from within a module sub routine but get
the message "Complie Error : Internal Error" nd the code halts at the
line.....

Dim cFileOpen As clsGetOpenFileName

which suggest to me that the class is not being recognised, the instancing
is set to Private - is this correct?, or do I need to do something else?

Sorry to be a pain but I'm new to class modules.

--
Cheers
Nigel



"Bob Phillips" wrote in message
...
The you need the API.

use a version encapsulated in a class module, attached below. To use it,
add this code to a class module, call it clsGetOpenFileName, and invoke it
is the following way

Dim cFileOpen As clsGetOpenFileName


Set cFileOpen = New clsGetOpenFileName


With cFileOpen
.FileName = "Ex*.xls"
.FileType = "Excel Files"
.DialogTitle = "Class GetOpenFileName Demo"
.MultiFile = "N"
.SelectFile


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


Set cFileOpen = Nothing


Other code is after my signature




--

HTH

RP
(remove nothere from the email address if mailing direct)



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
.nFilterIndex = 1 'Index to the initial
filter

.sFile = sFileName & Space$(1024) & vbNullChar &
vbNullChar

.nMaxFile = Len(.sFile)
.sDefFileExt = sFileName & vbNullChar & vbNullChar
.sFileTitle = vbNullChar & Space$(512) & _
vbNullChar & vbNullChar
.nMaxTitle = Len(OFN.sFileTitle)
.sInitialDir = ThisWorkbook.Path & vbNullChar

.sDialogTitle = sTitle

.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 the 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))
If pos Then
TrimNull = Left$(item, pos - 1)
Else
TrimNull = item
End If

End Function



"Nigel" wrote in message
...
Hi All,

I am using the following construct to select files......., which works
great.

xFile = Application.GetOpenFilename("ARTS_Daily (*.xls), *.xls", 1,
"Choose File", "", False)

I have a need to filter not just the file extension as in *.xls but also
the
filename eg ... ARTS*.xls, to give all xls files beginning with ARTS.
Something like.....

xFile = Application.GetOpenFilename("ARTS_Daily (ARTS*.xls),
ARTS*.xls",
1, "Choose File", "", False)

However this does not work as expected, with the dialog defaulting the
filter to All files *.*

Any ideas anyone on how best to achieve this?

--
Cheers
Nigel

Instancing Private is fine.

Double-check the class name, as that is the only thing I can think of that
will cause the problem.

--

HTH

RP
(remove nothere from the email address if mailing direct)


"Nigel" wrote in message
...
Hi Bob,
Wow! I have tried it but I have a problem.
I created the class module and pasted your code, named it
clsGetOpenFileName, I run the call from within a module sub routine but
get
the message "Complie Error : Internal Error" nd the code halts at the
line.....

Dim cFileOpen As clsGetOpenFileName

which suggest to me that the class is not being recognised, the instancing
is set to Private - is this correct?, or do I need to do something else?

Sorry to be a pain but I'm new to class modules.

--
Cheers
Nigel



"Bob Phillips" wrote in message
...
The you need the API.

use a version encapsulated in a class module, attached below. To use
it,
add this code to a class module, call it clsGetOpenFileName, and invoke
it
is the following way

Dim cFileOpen As clsGetOpenFileName


Set cFileOpen = New clsGetOpenFileName


With cFileOpen
.FileName = "Ex*.xls"
.FileType = "Excel Files"
.DialogTitle = "Class GetOpenFileName Demo"
.MultiFile = "N"
.SelectFile


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


Set cFileOpen = Nothing


Other code is after my signature




--

HTH

RP
(remove nothere from the email address if mailing direct)



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
.nFilterIndex = 1 'Index to the initial
filter

.sFile = sFileName & Space$(1024) & vbNullChar &
vbNullChar

.nMaxFile = Len(.sFile)
.sDefFileExt = sFileName & vbNullChar & vbNullChar
.sFileTitle = vbNullChar & Space$(512) & _
vbNullChar & vbNullChar
.nMaxTitle = Len(OFN.sFileTitle)
.sInitialDir = ThisWorkbook.Path & vbNullChar

.sDialogTitle = sTitle

.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 the 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))
If pos Then
TrimNull = Left$(item, pos - 1)
Else
TrimNull = item
End If

End Function



"Nigel" wrote in message
...
Hi All,

I am using the following construct to select files......., which works
great.

xFile = Application.GetOpenFilename("ARTS_Daily (*.xls), *.xls", 1,
"Choose File", "", False)

I have a need to filter not just the file extension as in *.xls but
also
the
filename eg ... ARTS*.xls, to give all xls files beginning with ARTS.
Something like.....

xFile = Application.GetOpenFilename("ARTS_Daily (ARTS*.xls),
ARTS*.xls",
1, "Choose File", "", False)

However this does not work as expected, with the dialog defaulting the
filter to All files *.*

Any ideas anyone on how best to achieve this?

--
Cheers
Nigel

Hi Bob

Double checked class module name, it is OK. I re-pasted the Class Module
code into the module and it works OK now.

It's curious, the first time I pasted the code into a un-named class (the
default class1), I then renamed it appropriately. If I re-name the class
module first and then paste it works! (more likely finger trouble on my
part!).

Anyway its just what I need, so thank you very much.

--
Cheers
Nigel



"Bob Phillips" wrote in message
...
Instancing Private is fine.

Double-check the class name, as that is the only thing I can think of that
will cause the problem.

--

HTH

RP
(remove nothere from the email address if mailing direct)


"Nigel" wrote in message
...
Hi Bob,
Wow! I have tried it but I have a problem.
I created the class module and pasted your code, named it
clsGetOpenFileName, I run the call from within a module sub routine but
get
the message "Complie Error : Internal Error" nd the code halts at the
line.....

Dim cFileOpen As clsGetOpenFileName

which suggest to me that the class is not being recognised, the
instancing
is set to Private - is this correct?, or do I need to do something else?

Sorry to be a pain but I'm new to class modules.

--
Cheers
Nigel



"Bob Phillips" wrote in message
...
The you need the API.

use a version encapsulated in a class module, attached below. To use
it,
add this code to a class module, call it clsGetOpenFileName, and
invoke
it
is the following way

Dim cFileOpen As clsGetOpenFileName


Set cFileOpen = New clsGetOpenFileName


With cFileOpen
.FileName = "Ex*.xls"
.FileType = "Excel Files"
.DialogTitle = "Class GetOpenFileName Demo"
.MultiFile = "N"
.SelectFile


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


Set cFileOpen = Nothing


Other code is after my signature




--

HTH

RP
(remove nothere from the email address if mailing direct)



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
.nFilterIndex = 1 'Index to the initial
filter

.sFile = sFileName & Space$(1024) & vbNullChar &
vbNullChar

.nMaxFile = Len(.sFile)
.sDefFileExt = sFileName & vbNullChar & vbNullChar
.sFileTitle = vbNullChar & Space$(512) & _
vbNullChar & vbNullChar
.nMaxTitle = Len(OFN.sFileTitle)
.sInitialDir = ThisWorkbook.Path & vbNullChar

.sDialogTitle = sTitle

.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 the
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))
If pos Then
TrimNull = Left$(item, pos - 1)
Else
TrimNull = item
End If

End Function



"Nigel" wrote in message
...
Hi All,

I am using the following construct to select files......., which
works
great.

xFile = Application.GetOpenFilename("ARTS_Daily (*.xls), *.xls",
1,
"Choose File", "", False)

I have a need to filter not just the file extension as in *.xls but
also
the
filename eg ... ARTS*.xls, to give all xls files beginning with
ARTS.
Something like.....

xFile = Application.GetOpenFilename("ARTS_Daily (ARTS*.xls),
ARTS*.xls",
1, "Choose File", "", False)

However this does not work as expected, with the dialog defaulting
the
filter to All files *.*

Any ideas anyone on how best to achieve this?

--
Cheers
Nigel

It isn't supported in GetOpenFileName

if you will just be using xl2002 or later, you might look at the FileDialog.
Here is an example that only shows b*.xls files

Sub Main()

'Declare a variable as a FileDialog object
Dim fd As FileDialog

'Create a FileDialog object '
' as a File Picker dialog box.
Set fd = Application.FileDialog( _
msoFileDialogFilePicker)

'Declare a variable to contain the path
'of each selected item.
'Even though the path is a String,
'the variable must be a Variant
'because For Each...Next
'routines only work with
'Variants and Objects.
Dim vrtSelectedItem As Variant

'Use a With...End With block to reference
'the FileDialog object.
With fd

'Set the initial path to the C:\ drive.
.InitialFileName = "C:\Data1\b*.xls"

'Use the Show method to display the
'File Picker dialog box and return the
' user's action.
'If the user presses the action button...
If .Show = -1 Then

'Step through each string '
'in the FileDialogSelectedItems collection.
For Each vrtSelectedItem _
In .SelectedItems

'vrtSelectedItem is a String
'that contains the path of
'each selected item.
'You can use any file I/O functions
'that you want to work with this path.
'This example simply displays
'the path in a message box.
MsgBox "Selected item's path: " _
& vrtSelectedItem

Next vrtSelectedItem
'If the user presses Cancel...
Else
End If
End With

'Set the object variable to Nothing.
Set fd = Nothing

End Sub


--
Regards,
Tom Ogilvy

"Nigel" wrote in message
...
Hi All,

I am using the following construct to select files......., which works
great.

xFile = Application.GetOpenFilename("ARTS_Daily (*.xls), *.xls", 1,
"Choose File", "", False)

I have a need to filter not just the file extension as in *.xls but also
the
filename eg ... ARTS*.xls, to give all xls files beginning with ARTS.
Something like.....

xFile = Application.GetOpenFilename("ARTS_Daily (ARTS*.xls),
ARTS*.xls",
1, "Choose File", "", False)

However this does not work as expected, with the dialog defaulting the
filter to All files *.*

Any ideas anyone on how best to achieve this?

--
Cheers
Nigel

Thanks Tom, I will be using xl97 so cannot progress this solution. It is
good to know anyway.

--
Cheers
Nigel



"Tom Ogilvy" wrote in message
...
It isn't supported in GetOpenFileName

if you will just be using xl2002 or later, you might look at the
FileDialog.
Here is an example that only shows b*.xls files

Sub Main()

'Declare a variable as a FileDialog object
Dim fd As FileDialog

'Create a FileDialog object '
' as a File Picker dialog box.
Set fd = Application.FileDialog( _
msoFileDialogFilePicker)

'Declare a variable to contain the path
'of each selected item.
'Even though the path is a String,
'the variable must be a Variant
'because For Each...Next
'routines only work with
'Variants and Objects.
Dim vrtSelectedItem As Variant

'Use a With...End With block to reference
'the FileDialog object.
With fd

'Set the initial path to the C:\ drive.
.InitialFileName = "C:\Data1\b*.xls"

'Use the Show method to display the
'File Picker dialog box and return the
' user's action.
'If the user presses the action button...
If .Show = -1 Then

'Step through each string '
'in the FileDialogSelectedItems collection.
For Each vrtSelectedItem _
In .SelectedItems

'vrtSelectedItem is a String
'that contains the path of
'each selected item.
'You can use any file I/O functions
'that you want to work with this path.
'This example simply displays
'the path in a message box.
MsgBox "Selected item's path: " _
& vrtSelectedItem

Next vrtSelectedItem
'If the user presses Cancel...
Else
End If
End With

'Set the object variable to Nothing.
Set fd = Nothing

End Sub


--
Regards,
Tom Ogilvy

"Nigel" wrote in message
...
Hi All,

I am using the following construct to select files......., which works
great.

xFile = Application.GetOpenFilename("ARTS_Daily (*.xls), *.xls", 1,
"Choose File", "", False)

I have a need to filter not just the file extension as in *.xls but also
the
filename eg ... ARTS*.xls, to give all xls files beginning with ARTS.
Something like.....

xFile = Application.GetOpenFilename("ARTS_Daily (ARTS*.xls),
ARTS*.xls",
1, "Choose File", "", False)

However this does not work as expected, with the dialog defaulting the
filter to All files *.*

Any ideas anyone on how best to achieve this?

--
Cheers
Nigel