如何获得EXCEl文件路径?

[wowosky]

我在abc.xls中写的宏,但无法获得当前文件的路径,请指教.
xlapp.path是EXCEL程序的路径.

[ZOU_SEAFARER]

默认是：
ffice2k是在"C:\Program Files\Microsoft Office\Office"
officeXP是在"C:\Program Files\Microsoft Office\Office10"
如果不是安装在C盘，或安装时自己改变了目录，又怎样得知？？？

请提供代码
---------------------------------------------------------------

读注册表
---------------------------------------------------------------

读注册表


模块
Option Explicit
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias _
"RegOpenKeyExA" (ByVal hKey As Long, _
ByVal lpSubKey As String, ByVal ulOptions As Long, _
ByVal samDesired As Long, phkResult As Long) _
As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" _
Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal _
lpValueName As String, ByVal lpReserved As Long, _
lpType As Long, ByVal lpData As String, lpcbData As Long) _
As Long

Private Declare Function RegCloseKey Lib "advapi32.dll" _
(ByVal hKey As Long) As Long
Private Const REG_SZ As Long = 1
Private Const KEY_ALL_ACCESS = &H3F
Private Const HKEY_LOCAL_MACHINE = &H80000002

Public Function GetWordPath() As String
GetWordPath = GetOfficeAppPath("Word.Application")
End Function
Public Function GetExcelPath() As String
GetExcelPath = GetOfficeAppPath("Excel.Application")
End Function
Public Function GetAccessPath() As String
GetAccessPath = GetOfficeAppPath("Access.Application")
End Function
Public Function GetOutlookPath() As String
GetOutlookPath = GetOfficeAppPath("Outlook.Application")
End Function
Public Function GetPowerPointPath() As String
GetPowerPointPath = _
GetOfficeAppPath("PowerPoint.Application")
End Function
Public Function GetFrontPagePath() As String
GetFrontPagePath = GetOfficeAppPath("FrontPage.Application")
End Function
Private Function GetOfficeAppPath(ByVal ProgID As String) _
As String
Dim lKey As Long
Dim lRet As Long
Dim sClassID As String
Dim sAns As String
Dim lngBuffer As Long
Dim lPos As Long
'GetClassID
lRet = RegOpenKeyEx(HKEY_LOCAL_MACHINE, _
"Software\Classes\" & ProgID & "\CLSID", 0&, _
KEY_ALL_ACCESS, lKey)
If lRet = 0 Then

lRet = RegQueryValueEx(lKey, "", 0&, REG_SZ, "", lngBuffer)
sClassID = Space(lngBuffer)
lRet = RegQueryValueEx(lKey, "", 0&, REG_SZ, sClassID, _
lngBuffer)
'drop null-terminator
sClassID = Left(sClassID, lngBuffer - 1)
RegCloseKey lKey
End If


'Get AppPath
lRet = RegOpenKeyEx(HKEY_LOCAL_MACHINE, _
"Software\Classes\CLSID\" & sClassID & _
"\LocalServer32", 0&, KEY_ALL_ACCESS, lKey)

If lRet = 0 Then
lRet = RegQueryValueEx(lKey, "", 0&, REG_SZ, "", lngBuffer)
sAns = Space(lngBuffer)
lRet = RegQueryValueEx(lKey, "", 0&, REG_SZ, sAns, _
lngBuffer)
sAns = Left(sAns, lngBuffer - 1)

RegCloseKey lKey
End If

lPos = InStr(sAns, "/")
If lPos > 0 Then
sAns = Trim(Left(sAns, lPos - 1))
End If

GetOfficeAppPath = sAns

End Function


测试
Private Sub Command1_Click()
MsgBox GetWordPath()
End Sub

[happy_sea]

VBA中获取当前活动文档的路径：
application.ActiveWorkbook.Path

[清晨曦月]

楼上正解

[wowosky]

嫁分