类模块基础

附带东野圭吾小说集（txt文件）http://pan.baidu.com/s/1slMSFxj

类模块有多种用途，主要用于以下几个方面：

1.封装相似功能到单个对象中

2.建立带有属性、方法和事件的对象

3.特为自定义集合建立类模块

封装相似功能：

以一个名为clsUStationDialog的类开始。

使用这个类能做些什么：

显示打开MicroStation DGN文件的FileOpen对话框

显示打开Microsoft Excel文件的FileOpen对话框

显示打开ASCII.txt文件的FileOpen对话框

显示打开用户指定扩展名的FileOpen对话框

文件名需要的属性

仅路径需要的属性

路径/文件名需要的属性

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

Dim tmpFileExt As String

tmpFileExt = LCase(Replace(FileExt, ".", ""))

For I = 1 To UBound(pFileExts)

If tmpFileExt = pFileExts(I) Then

Exit Sub

End If

Next I

ReDim Preserve pFileExts(UBound(pFileExts) + 1)

pFileExts(UBound(pFileExts)) = tmpFileExt

End Sub

Sub CreateDialog()

Dim tmpFilter As String

pRetVal = 1

tmpFilter = "*." & Join(GetExts, "; *.")

pFileNameSelected = Space(255)

pRetVal = mdlDialog_fileCreate(pFileNameSelected, 0, 0, _

pDefFileName, tmpFilter, pDefFilePath, "Create 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)) = ""

pFliePath = Join(xSplit, "")

End Select

End Sub

测试代码1：

Sub TestShowDialogA()

Dim MyUSD As New clsUSataionDialog

MyUSD.AddFileExt "dgn"

MyUSD.DefaultPath = "c:"

MyUSD.DefaultFile = "temp.dgn"

MyUSD.OpenDialog

Select Case MyUSD.OpenSuccess

Case True

MsgBox MyUSD.SelectedPath & MyUSD.SelectedFile

End Select

End Sub

测试截图：

测试代码2：

Sub TestShowDialogB()

Dim MyUSD As New clsUSataionDialog

MyUSD.AddFileExt "dgn"

MyUSD.AddFileExt "dwg"

MyUSD.AddFileExt "dxf"

MyUSD.DefaultFile = "c:MicroStation VBA"

MyUSD.DefaultFile = "test.dgn"

MyUSD.OpenDialog

Select Case MyUSD.OpenSuccess

Case True

MsgBox MyUSD.SelectedPath & MyUSD.SelectedFile

End Select

End Sub

测试截图2：

测试代码3：

Sub TestShowDialogC()

Dim MyUSD As New clsUSataionDialog

MyUSD.AddFileExt "dgn"

MyUSD.DefaultFile = "c:"

MyUSD.DefaultFile = "test.dgn"

MyUSD.CreateDialog

Select Case MyUSD.OpenSuccess

Case True

MsgBox MyUSD.SelectedPath & MyUSD.SelectedFile

End Select

End Sub

测试截图3：

测试代码4：

Sub TestShowDialogD()

Dim MyUSD As New clsUSataionDialog

MyUSD.AddFileExt "ILoveyou"

MyUSD.AddFileExt " LOVEYOU"

MyUSD.AddFileExt "Forever"

MyUSD.DefaultPath = "c:MicroStation VBA"

MyUSD.DefaultFile = "test.dgn"

MyUSD.CreateDialog

Select Case MyUSD.OpenSuccess

Case True

MsgBox MyUSD.SelectedPath & MyUSD.SelectedFile

End Select

End Sub

测试截图4：

测试代码5：

Sub TestShowDialogE()

Dim MyUSD As New clsUSataionDialog

MyUSD.AddFileExt "loveyou"

MyUSD.DefaultPath = "c:"

MyUSD.DefaultFile = "test.dgn"

MyUSD.OpenDialog

Select Case MyUSD.OpenSuccess

Case True

MsgBox "Open " & MyUSD.SelectedPath & _

MyUSD.SelectedFile

Case False

If MsgBox("Create a new file?", vbYesNo) = vbYes Then

MyUSD.CreateDialog

If MyUSD.OpenSuccess = True Then

MsgBox "Create" & MyUSD.SelectedPath & _

MyUSD.SelectedFile

End If

End If

End Select

End Sub

测试截图5：