字符串函数系列之二

Public Function ReplaceMultiChar(ByVal sData As String, ByVal sChar As String) As String ‘用单字符替换连续字符
sData = Trim(sData)
Dim iBefore, iAfter As Integer
Do
iBefore = Len(sData)
sData = Replace(sData, sChar & sChar, sChar)
iAfter = Len(sData)
Loop Until iBefore = iAfter
ReplaceMultiChar = sData
End Function

Public Function GetExtension(ByVal sName As String) As String ‘扩展名
GetExtension = “”
If InStr(1, sName, “.”, vbTextCompare) = 0 Then Exit Function
Dim TempArray As Variant
TempArray = Split(sName, “.”, -1, vbTextCompare) ‘名字可能会含 .
GetExtension = TempArray(UBound(TempArray)) ‘扩展名
End Function

Public Function GetBare(ByVal sName As String) As String ‘不带扩展名的名
GetBare = “”
If InStr(1, sName, “.”, vbTextCompare) = 0 Then Exit Function
Dim TempArray As Variant
TempArray = Split(sName, “.”, -1, vbTextCompare) ‘名字可能会含 .
ReDim Preserve TempArray(LBound(TempArray) To UBound(TempArray) – 1) ‘去扩展名
GetBare = Join(TempArray, “.”)
End Function

Public Function GetFullName(ByVal sPath As String, ByVal sShortName As String) As String ‘文件全名
‘If Right(sPath, 1) = “\” Then
‘GetFullName = sPath & sShortName
‘Else
‘GetFullName = sPath & “\” & sShortName
‘End If
‘下句等同以上内容
GetFullName = IIf(Right(sPath, 1) = “\” Or Left(sShortName, 1) = “\”, sPath & sShortName, sPath & “\” & sShortName)
GetFullName = ReplaceMultiChar(GetFullName, “\”)
End Function

Public Function GetShortName(ByVal sFullName As String) As String ‘文件短名
If sFullName = “” Then
GetShortName = “”
Else
Dim TempArray As Variant
TempArray = Split(sFullName, “\”, -1, vbTextCompare)
GetShortName = TempArray(UBound(TempArray))
End If
End Function

Public Function GetPath(ByVal sFullName As String) As String ‘文件路径
‘Dim I As Integer
‘For I = Len(sFullName) To 1 Step -1
‘If Mid(sFullName, I, 1) = “\” Then
‘GetPath = Left(sFullName, I – 1)
‘Exit Function
‘End If
‘Next I
Dim TempArray As Variant
TempArray = Split(sFullName, “\”, -1, vbTextCompare)
If LBound(TempArray) = UBound(TempArray) Then ‘短名
GetPath = “”
Else
ReDim Preserve TempArray(LBound(TempArray) To UBound(TempArray) – 1) As String
GetPath = Join(TempArray, “\”)
End If
End Function

Public Function GetShortPath(ByVal sFullName As String) As String ‘文件当前文件夹
Dim TempArray As Variant
TempArray = Split(sFullName, “\”, -1, vbTextCompare)
GetShortPath = TempArray(UBound(TempArray) – 1)
End Function

Public Function DirExist(ByVal sData As String) As Boolean ‘(全名)目录存在
DirExist = False
If Trim(sData) = “” Then Exit Function ‘Dir(“”) 出错, 且无声无息
If Dir(sData, vbDirectory) = “” Then Exit Function ‘不存在
If Not (GetAttr(sData) And vbDirectory) = vbDirectory Then Exit Function ‘是文件
DirExist = True
End Function

Public Function FileExist(ByVal sData As String) As Boolean ‘(全名)文件存在
FileExist = False
If Trim(sData) = “” Then Exit Function ‘Dir(“”) 出错, 且无声无息
If Dir(sData) = “” Then Exit Function ‘不存在
If (GetAttr(sData) And vbDirectory) = vbDirectory Then Exit Function ‘是目录
FileExist = True
End Function

发表回复

您的邮箱地址不会被公开。 必填项已用 * 标注