不用api，vb自带函数得到文件名或扩展名(2)

Public Function FileWhetherBeing(ByVal FileAbsolutelyPath As String) As Boolean   '检查文件是否存在
   FileWhetherBeing = CBool(Len(Dir(FileAbsolutelyPath, vbArchive + vbHidden + vbNormal + vbReadOnly + vbSystem)))
End Function

Public Sub WriteStringArray(ArrayName() As String, ArrayAmount As Long, ByVal ArrayValue As String)    '字符串数组赋值
   ArrayAmount = ArrayAmount + 1
   ReDim Preserve ArrayName(1 To ArrayAmount) As String
   ArrayName(ArrayAmount) = ArrayValue
End Function

Public Function ExtractionFileName(ByVal CompletePath As String) As String   '全路径提取文件名(带扩展名)
Dim T As Variant
   If InStr(1, CompletePath, ":\") = 0 Or Right$(CompletePath, 1) = "\" Then Exit Function
   T = Split(CompletePath, "\")
   ExtractionFileName = T(UBound(T))
End Function

Public Function ExtractionFileName2(ByVal CompletePath As String) As String   '全路径提取文件名(不带扩展名)
   ExtractionFileName2 = ExtractionFileName(CompletePath)
   ExtractionFileName2 = Mid(ExtractionFileName2, 1, Len(ExtractionFileName2) - Len(ExtractionFileFormat(CompletePath)) - 1)
End Function

Public Function ExtractionFileFormat(ByVal CompletePath As String) As String   '全路径提取扩展名
Dim T As Variant
   If InStr(1, CompletePath, ".") = 0 Or InStr(1, CompletePath, ":\") = 0 Then Exit Function
   T = Split(CompletePath, ".")
   If InStr(1, T(UBound(T)), "\") = 0 Then ExtractionFileFormat = T(UBound(T))
End Function

Public Function ExtractionFolderPath(ByVal CompletePath As String) As String   '全路径提取文件夹路径
Dim I%, T, A%
   If Right$(CompletePath, 1) = "\" Then
      ExtractionFolderPath = CompletePath
      Exit Function
   End If
   If InStr(1, CompletePath, ":\") = 0 Then Exit Function
   T = Split(CompletePath, "\")
   A = InStr(1, CompletePath, T(UBound(T))) - 1
   ExtractionFolderPath = Mid(CompletePath, 1, A)
End Function

Public Function TimeFilePath(ByVal FolderPath As String, ByVal FileFormat As String) As String   '按照时间日期创建文件路径
Dim A%
   If Right(FolderPath, 1) <> "\" Then FolderPath = FolderPath & "\"
   If Left(FileFormat, 1) <> "." Then FileFormat = "." & FileFormat
   A = 10
   Do
      TimeFilePath = FolderPath & Format(Now, "YYYY-MM-DD_hh-mm-ss") & "_" & A & FileFormat
      A = A + 1
   Loop While Len(Dir(TimeFilePath, vbArchive + vbHidden + vbNormal + vbReadOnly + vbSystem)) > 0
   If A = 11 Then TimeFilePath = FolderPath & Format(Now, "YYYY-MM-DD_hh-mm-ss") & FileFormat
End Function


Public Function FolderPathCheck(ByVal FolderPath As String) As String   '确保文件夹路径最右边字符串为“\”
   If Right$(FolderPath, 1) <> "\" Then FolderPath = FolderPath & "\"
   FolderPathCheck = FolderPath
End Function

'————————————————————————————————————————————

Private Sub Command2_Click()'全路径提取文件名
   Text3.Text = ExtractionFileName("c:\h.h\h.h\hm\ymy.txt")
   Text13.Text = ExtractionFileName2("c:\h.h\h.h\hm\ymy.txt")
End Sub

Private Sub Command1_Click() '全路径提取扩展名
   Text2.Text = ExtractionFileFormat("c:\h.h\h.h\hm\ymy.txt")
End Sub

Private Sub Command4_Click() '全路径提取文件夹路径
   Text5.Text = ExtractionFolderPath("c:\h.h\h.h\hm\ymy.txt")
End Sub

Private Sub Command3_Click() '文件是否存在
   Text4.Text = FileWhetherBeing("c:\h.h\h.h\hm\ymy.txt")
End Sub

Private Sub Command5_Click() '按照时间日期创建文件路径
   Text6.Text = TimeFilePath("z:\", "txt")
End Sub

Private Sub Command7_Click() '字符串数组赋值
Dim STR$(), A&, I&
   For I = 1 To 24
      If (I \ 3) * 3 = I Then
         WriteStringArray STR, A, CStr(I \ 3)
      End If
   Next
   List1.Clear
   If A > 0 Then
      For I = 1 To A
         List1.AddItem STR(I)
      Next
   End If
End Sub