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,".") = 0 Or InStr(1,":\") = 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,"\") A = InStr(1,T(UBound(T))) - 1 ExtractionFolderPath = Mid(CompletePath,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 原文链接：https://www.f2er.com/vb/260766.html