Private Declare Function mdlDialog_fileOpen Lib "stdmdlbltin.dll" (ByVal _
fileName As String, ByVal rFileH As Long, ByVal _
resourceId As Long, ByVal suggestedFileName As String, _
ByVal filterString As String, ByVal defaultDirectory As String, _
ByVal titleString As String) As Long
Private Declare Function mdlDialog_fileCreate Lib _
"stdmdlbltin.dll" (ByVal _
fileName As String, ByVal rFileH As Long, _
ByVal resourceId As Long, _
ByVal suggestedFileName As String, _
ByVal filterString As String, _
ByVal defaultDirectory As String, _
ByVal titleString As String) As Long
Private pFilePath As String
Private pFileName As String
Private pDefFilePath As String
Private pDefFileName As String
Private pFileNameSelected As String
Private pRetVal As Long
Private pFileExts() As String
Property Get SelectedPath() As String
SelectedPath = pFilePath
End Property
Property Get SelectedFile() As String
SelectedFile = pFileName
End Property
Property Get OpenSuccess() As Boolean
Select Case pRetVal
Case 1 '取消
OpenSuccess = False
Case 0 '打开
OpenSuccess = True
End Select
End Property
Sub OpenDialog()
Dim tmpFilter As String
pRetVal = 1
tmpFilter = "*." & Join(GetExts, "; *.")
pFileNameSelected = Space(255)
pRetVal = mdlDialog_fileOpen(pFileNameSelected, 0, 0, _
pDefFileName, tmpFilter, pDefFilePath, "Open File")
Select Case pRetVal
Case 1 '取消
Case 0 '打开
Dim tmpFile As String
Dim xSplit As Variant
tmpFile = Left(pFileNameSelected, InStr(1, _
pFileNameSelected, Chr(0)) - 1)
xSplit = Split(tmpFile, "\")
pFileName = xSplit(UBound(xSplit))
xSplit(UBound(xSplit)) = ""
pFilePath = Join(xSplit, "\")
End Select
End Sub
Property Get DefaultFile() As String
DefaultFile = pDefFileName
End Property
Property Let DefaultFile(strFilIn As String)
pDefFileName = strFileIn
End Property
Property Get DefaultPath() As String
DefaultPath = pDefFilePath
End Property
Property Let DefaultPath(strPathIN As String)
On Error GoTo errhnd
If Dir(strPathIN, vbDirectory) <> "" Then
pDefFilePath = strPathIN
End If
Exit Property
errhnd:
Select Case Err.Number
Case 52 '错误文件名或文件号
Err.Clear
End Select
End Property
Property Get ExtCount() As Long
ExtCount = UBound(pFileExts)
End Property
Property Get GetExts() As String()
If UBound(pFileExts) = 0 Then
Exit Property
End If
Dim tmpGetExts() As String
ReDim tmpGetExts(UBound(pFileExts) - 1) As String
Dim I As Long
For I = 1 To UBound(pFileExts)
tmpGetExts(I - 1) = pFileExts(I)
Next I
GetExts = tmpGetExts
End Property
Private Sub Class_Initialize()
ReDim pFileExts(0)
End Sub
Public Sub AddFileExt(FileExt As String)
Dim I As Long
Di
