|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
Attribute VB_Name = "API_SplitPath_Unicode"
Option Private Module '如果希望在表格内显式调用,关闭该语句
Option Explicit
'将本文件导入你的VBA工程即可使用,如果您使用MS9.0运行时库,将"MSVCR100.DLL" 更改为"MSVCR90.DLL"
Declare PtrSafe Function Splitpath Lib "MSVCR100.DLL" Alias "_wsplitpath_s" (ByVal FullPath As LongPtr, _
ByVal Drive As LongPtr, ByVal DriveSize As Long, _
ByVal Dir As LongPtr, ByVal DirSize As Long, _
ByVal Filename As LongPtr, ByVal FilenameSize As Long, _
ByVal Ext As LongPtr, ByVal ExtSize As Long) As Long
'返回字符串中第一个vbNullChar字符以前的字符串,不包括vbNullChar本身
Public Function DelStrNull(ByVal retStr As String) As String
Dim N As Integer
N = InStr(1, retStr, vbNullChar)
If (N >= 1) Then
retStr = Left(retStr, N - 1)
End If
DelStrNull = retStr
End Function
'Bz=0----返回 Ext
'Bz=1----返回 Fname
'Bz=2----返回 Dir
'Bz=3----返回 Drive
'Bz=4----返回 Fname+Ext
'Bz=5----返回 Drive+Dir
Function GetFilePart(ByVal FullPath As String, Optional Bz As Integer = 4) As String
Dim sStr As String
Dim sStr2 As String
Dim Rt As Integer
sStr = String(260, vbNullChar)
If (Bz = 0) Then
Rt = Splitpath(StrPtr(FullPath & vbNullChar), StrPtr(vbNullString), 0, StrPtr(vbNullString), 0, StrPtr(vbNullString), 0, StrPtr(sStr), 260)
ElseIf (Bz = 1) Then
Rt = Splitpath(StrPtr(FullPath & vbNullChar), StrPtr(vbNullString), 0, StrPtr(vbNullString), 0, StrPtr(sStr), 260, StrPtr(vbNullString), 0)
ElseIf (Bz = 2) Then
Rt = Splitpath(StrPtr(FullPath & vbNullChar), StrPtr(vbNullString), 0, StrPtr(sStr), 260, StrPtr(vbNullString), 0, StrPtr(vbNullString), 0)
ElseIf (Bz = 3) Then
Rt = Splitpath(StrPtr(FullPath & vbNullChar), StrPtr(sStr), 260, StrPtr(vbNullString), 0, StrPtr(vbNullString), 0, StrPtr(vbNullString), 0)
ElseIf (Bz = 5) Then
sStr2 = String(260, vbNullChar)
Rt = Splitpath(StrPtr(FullPath & vbNullChar), StrPtr(sStr), 260, StrPtr(sStr2), 260, StrPtr(vbNullString), 0, StrPtr(vbNullString), 0)
Else
sStr2 = String(260, vbNullChar)
Rt = Splitpath(StrPtr(FullPath & vbNullChar), StrPtr(vbNullString), 0, StrPtr(vbNullString), 0, StrPtr(sStr), 260, StrPtr(sStr2), 260)
End If
If (Bz > 3) Then
GetFilePart = DelStrNull(sStr) + DelStrNull(sStr2)
Else
GetFilePart = DelStrNull(sStr)
End If
End Function
-----------------------------
以上是导出的bas文件,将这个文件直接导入VBA工程就可以使用
我只在win64--VBA7.0下实验了。VBS7.0---Win32应该也可以 |
评分
-
1
查看全部评分
-
|