获取当前文件完整路径、路径、文件名、扩展名

注册小号

在开发vba代码时，往往遇到获取当前文件完整路径、路径、文件名、扩展名的问题，为此，写此例共同学习。

示例背景：
在“示例.xls”（“示例”xla同理）中存有基础数据表以便在运行代码时进行存取操作，如：
Workbooks(“示例.xls”).Sheets("**").cells(*,*)*********************
但由于“示例.xls”在分发给其他人后，可能会被更改存放路径、文件名称，导致上面代码中的Workbooks(“示例.xls”)无效，较难维护。
为此，下面的例子在打开“示例.xls”时，将其文件完整路径、路径、文件名、扩展名存入“示例.xls”中提前建好的“系统参数”工作表中。

第一步：新建“示例.xls”，插入新工作表，重命名为“系统参数”。在A列逐行键入以下内容，用以说明B列字符串含义，B列则用于存放文件完整路径、路径、文件名、扩展名字符串参数，保存。

“示例.xls”——"系统参数"

第二步：新建模块，粘入以下代码，保存。
Dim MyFPath, MyPPath, MyFname, MyName, MyEName As String '声明公共变量
Private Sub auto_open()
ThisWorkbook.Sheets("系统参数").Cells(1, 2).Value = ThisWorkbook.FullName '完整路径，路径+文件名+扩展名
ThisWorkbook.Sheets("系统参数").Cells(2, 2).Value = ThisWorkbook.Path '不带文件名的路径
ThisWorkbook.Sheets("系统参数").Cells(3, 2).Value = ThisWorkbook.Name '带扩展名的文件名
Set fs = CreateObject("Scripting.FileSystemObject") '
ThisWorkbook.Sheets("系统参数").Cells(4, 2).Value = fs.GetbaseName(ThisWorkbook.FullName) '不带扩展名的文件名
ThisWorkbook.Sheets("系统参数").Cells(5, 2).Value = fs.GetExtensionname(ThisWorkbook.FullName) '扩展名
End Sub
第三步：修改宏代码。

在代码区前面加入公共变量赋值语句。
MyFPath = ThisWorkbook.Sheets("系统参数").Cells(1, 2).Value '赋值，完整路径，路径+文件名+扩展名
MyPPath = ThisWorkbook.Sheets("系统参数").Cells(2, 2).Value '赋值，不带文件名的路径
MyFname = ThisWorkbook.Sheets("系统参数").Cells(3, 2).Value '带扩展名的文件名
MyName = ThisWorkbook.Sheets("系统参数").Cells(4, 2).Value '赋值，不带扩展名的文件名
MyExtname = ThisWorkbook.Sheets("系统参数").Cells(5, 2).Value '赋值，扩展名
……
将宏代码中的相关字符串替换为变量名，如：
Workbooks(“示例.xls”).Sheets("**").cells(*,*)*********************
改为：
Workbooks(MyFname ).Sheets("**").cells(*,*)*********************
保存。
ok！

模块代码完整如下：
Dim MyFPath, MyPPath, MyFname, MyName, MyEName As String '声明公共变量
Private Sub auto_open()
ThisWorkbook.Sheets("系统参数").Cells(1, 2).Value = ThisWorkbook.FullName '完整路径，路径+文件名+扩展名
ThisWorkbook.Sheets("系统参数").Cells(2, 2).Value = ThisWorkbook.Path '不带文件名的路径
ThisWorkbook.Sheets("系统参数").Cells(3, 2).Value = ThisWorkbook.Name '带扩展名的文件名
Set fs = CreateObject("Scripting.FileSystemObject") '
ThisWorkbook.Sheets("系统参数").Cells(4, 2).Value = fs.GetbaseName(ThisWorkbook.FullName) '不带扩展名的文件名
ThisWorkbook.Sheets("系统参数").Cells(5, 2).Value = fs.GetExtensionname(ThisWorkbook.FullName) '扩展名
End Sub
Sub 示例()
'在代码区前面加入公共变量赋值语句。
MyFPath = ThisWorkbook.Sheets("系统参数").Cells(1, 2).Value '赋值，完整路径，路径+文件名+扩展名
MyPPath = ThisWorkbook.Sheets("系统参数").Cells(2, 2).Value '赋值，不带文件名的路径
MyFname = ThisWorkbook.Sheets("系统参数").Cells(3, 2).Value '带扩展名的文件名
MyName = ThisWorkbook.Sheets("系统参数").Cells(4, 2).Value '赋值，不带扩展名的文件名
MyExtname = ThisWorkbook.Sheets("系统参数").Cells(5, 2).Value '赋值，扩展名

'代码区，以弹出对话框为例，调用"示例.xls"Sheets1内容计算并输出。
Dim Msg, Style, Title, Help, Ctxt, Response, MyString
Msg = "请选择按钮!"    ' 定义信息。
Style = vbYesNoCancel  ' 定义按钮。
Title = "示例"         ' 定义标题。
Response = MsgBox(Msg, Style, Title)
If Response = vbYes Then
    '要执行的代码
    MsgBox Workbooks(MyFname).Sheets("Sheet1").Cells(1, 2).Value * 100
ElseIf Response = vbNo Then
    '要执行的代码
    MsgBox Workbooks(MyFname).Sheets("Sheet1").Cells(2, 2).Value * 100
ElseIf Response = vbCancel Then
    '要执行的代码
    MsgBox Workbooks(MyFname).Sheets("Sheet1").Cells(3, 2).Value * 100
End If

End Sub
“示例.xls”附件如下：

看见星光

感谢分享，有空常来。

feilang5000

谢谢帮助！

-z-

这个赋值扩展名的语句为什么无法运行，说是要求对象，MyEName = fs.GetExtensionname(ActiveWorkbook.FullName)

-z-

这个赋值扩展名的语句为什么无法运行，说是要求对象，MyEName = fs.GetExtensionname(ActiveWorkbook.FullName)

-z-

这个赋值扩展名的语句为什么无法运行，说是要求对象，MyEName = fs.GetExtensionname(ActiveWorkbook.FullName)

a65533061

学习了，留位收藏

yvhusrwg414

留位收藏,谢谢!