不用api，vb自带函数得到文件名或扩展名(2)
发布时间：2020-12-16 22:46:07 所属栏目：大数据 来源：网络整理
导读：Public Function FileWhetherBeing(ByVal FileAbsolutelyPath As String) As Boolean '检查文件是否存在 FileWhetherBeing = CBool(Len(Dir(FileAbsolutelyPath,vbArchive + vbHidden + vbNormal + vbReadOnly + vbSystem))) End Function Public Sub WriteSt
|
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.hh.hhmymy.txt") Text13.Text = ExtractionFileName2("c:h.hh.hhmymy.txt") End Sub Private Sub Command1_Click() '全路径提取扩展名 Text2.Text = ExtractionFileFormat("c:h.hh.hhmymy.txt") End Sub Private Sub Command4_Click() '全路径提取文件夹路径 Text5.Text = ExtractionFolderPath("c:h.hh.hhmymy.txt") End Sub Private Sub Command3_Click() '文件是否存在 Text4.Text = FileWhetherBeing("c:h.hh.hhmymy.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 （编辑：李大同） 【声明】本站内容均来自网络，其相关言论仅代表作者个人观点，不代表本站立场。若无意侵犯到您的权利，请及时与联系站长删除相关内容! |