我编写了一个Excel VBA宏，可以从本地存储的HTML文件导入数据，然后对这些数据进行计算。
目前，这个HTML文件是通过绝对路径引用的：
Workbooks.Open FileName:="C:\Documents and Settings\Senior Caterer\My Documents\Endurance Calculation\TRICATEndurance Summary.html"
然而，我希望使用相对路径来引用它，而不是绝对路径（因为我想将电子表格分发给可能没有使用相同文件夹结构的同事）。由于html文件和Excel电子表格位于同一文件夹中，我认为这不应该很难，但我完全无法做到。我在网上搜索过，并且所提供的解决方案似乎都非常复杂。
我在工作中使用的是Excel 2000和2002，但是因为我计划进行分发，所以希望它能与尽可能多的Excel版本兼容。
非常感谢您的任何建议。
仅为澄清yalestar所说的，这将给您相对路径：
Workbooks.Open FileName:= ThisWorkbook.Path & "\TRICATEndurance Summary.html"
您可以使用以下任何一个作为相对路径的根目录：
ActiveWorkbook.Path
ThisWorkbook.Path
App.Path
Workbooks.Open FileName:= "TRICATEndurance Summary.html"就足够了。如果您要使用路径进行计算，可以将当前目录表示为 . ，然后\告诉文件在该目录中，在必须将操作系统的当前目录更改为工作簿的路径时，您可以使用ChDrive和ChDir来完成。"最初的回答"ChDrive ThisWorkbook.Path
ChDir ThisWorkbook.Path
Workbooks.Open FileName:= ".\TRICATEndurance Summary.html"
ChDir ThisWorkbook.Path
我认为最好使用ThisWorkbook.Path来构建HTML文件的路径。我非常喜欢Scripting Runtime中的FileSystemObject（似乎总是已安装），因此在设置对Microsoft Scripting Runtime的引用后，我更愿意这样做：
Const HTML_FILE_NAME As String = "my_input.html"
With New FileSystemObject
With .OpenTextFile(.BuildPath(ThisWorkbook.Path, HTML_FILE_NAME), ForReading)
' Now we have a TextStream object that we can use to read the file
End With
End With
Private Sub btn_browser_file_Click()
Dim xRow As Long
Dim sh1 As Worksheet
Dim xl_app As Excel.Application
Dim xl_wk As Excel.Workbook
Dim WS As Workbook
Dim xDirect$, xFname$, InitialFoldr$
InitialFoldr$ = "C:\"
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = Application.DefaultFilePath & "\"
.Title = "Please select a folder to list Files from"
.InitialFileName = InitialFoldr$
.Show
Range("H13").Activate
If .SelectedItems.Count <> 0 Then
xDirect$ = .SelectedItems(1) & "\"
Range("h12").Value = xDirect$
xFname$ = Dir(xDirect$, 7)
Do While xFname$ <> ""
If (Format(FileDateTime(xDirect$ & "\" & xFname$), "MM/DD/YYYY") > Format(Range("H10").Value, "MM/DD/YYYY")) Then
ActiveCell.Offset(xRow) = xFname$
xRow = xRow + 1
xFname$ = Dir
Else
xFname$ = Dir
xRow = xRow
End If
Loop
End If
End With
Workbooks.Open FileName:=GetAbsolutePath("..\..\TRICATEndurance Summary.html")
代码：
' Gets an absolute path from a relative path in the active workbook
Public Function GetAbsolutePath(relativePath As String) As String
Dim absPath As String
Dim pos As Integer
absPath = ActiveWorkbook.Path
' Make sure paths are in correct format
relativePath = Replace(relativePath, "/", "\")
absPath = Replace(absPath, "/", "\")
Do While Left$(relativePath, 3) = "..\"
' Remove level from relative path
relativePath = Mid$(relativePath, 4)
' Remove level from absolute path
pos = InStrRev(absPath, "\")
absPath = Left$(absPath, pos - 1)
Loop
GetAbsolutePath = PathCombine(absPath, relativePath)
End Function
我认为这可能会有所帮助。以下宏检查文件夹是否存在，如果不存在，则创建该文件夹并将其保存为xls和pdf格式，保存在该文件夹中。恰好该文件夹与相关人员共享，因此每个人都可以得到更新。
Sub PDF_laudo_e_Prod_SP_Sem_Ajuste_Preco()
'
' PDF_laudo_e_Prod_SP_Sem_Ajuste_Preco Macro
'
'
Dim MyFolder As String
Dim LaudoName As String
Dim NF1Name As String
Dim OrigFolder As String
MyFolder = ThisWorkbook.path & "\" & Sheets("Laudo").Range("C9")
LaudoName = Sheets("Laudo").Range("K27")
NF1Name = Sheets("PROD SP sem ajuste").Range("Q3")
OrigFolder = ThisWorkbook.path
Sheets("Laudo").Select
Columns("D:P").Select
Selection.EntireColumn.Hidden = True
If Dir(MyFolder, vbDirectory) <> "" Then
Sheets("Laudo").ExportAsFixedFormat Type:=xlTypePDF, filename:=MyFolder & "\" & LaudoName & ".pdf", Quality:=xlQualityMinimum, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False
Sheets("PROD SP sem ajuste").ExportAsFixedFormat Type:=xlTypePDF, filename:=MyFolder & "\" & NF1Name & ".pdf", Quality:=xlQualityMinimum, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False
ThisWorkbook.SaveAs filename:=MyFolder & "\" & LaudoName
Application.DisplayAlerts = False
ThisWorkbook.SaveAs filename:=OrigFolder & "\" & "Entregas e Instrucao Barter 2015 - beta"
Application.DisplayAlerts = True
Else
MkDir MyFolder
Sheets("Laudo").ExportAsFixedFormat Type:=xlTypePDF, filename:=MyFolder & "\" & LaudoName & ".pdf", Quality:=xlQualityMinimum, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False
Sheets("PROD SP sem ajuste").ExportAsFixedFormat Type:=xlTypePDF, filename:=MyFolder & "\" & NF1Name & ".pdf", Quality:=xlQualityMinimum, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False
ThisWorkbook.SaveAs filename:=MyFolder & "\" & LaudoName
Application.DisplayAlerts = False
ThisWorkbook.SaveAs filename:=OrigFolder & "\" & "Entregas e Instrucao Barter 2015 - beta"
Application.DisplayAlerts = True
End If
Sheets("Laudo").Select
Columns("C:Q").Select
Selection.EntireColumn.Hidden = False
Range("A1").Select
End Sub
这也许不是最好的方法。但我找到的唯一获取绝对路径的方法是计算字符串中语法“..”出现的次数，然后使用函数gotoparent多次，直到该语法在超链接地址中出现相应的次数。（在我的情况下，我的字段是一个超链接地址。 附注：此代码需要引用Microsoft Scripting Runtime。
Function AbsolutePath(strRelativePath As String, strCurrentFileName As String) As String
Dim fso As Object
Dim strCurrentProjectpath As String
Dim strGoToParentFolder As String
Dim strOrigineFolder As String
Dim strPath As String
Dim lngParentFolder As Long
''Pour retrouver le répertoire parent
Set fso = CreateObject("Scripting.FileSystemObject")
'' détermine le répertire du projet actif
strCurrentProjectpath = CurrentProject.Path
'' détermine le nom du répertoire dans lequel le fichier d'origine se trouve
strOrigineFolder = Replace(Replace(Replace(strRelativePath, strCurrentFileName, ""), "..", ""), "\", "")
''Extraction du chemin relatif (ex. ..\..\..)
strGoToParentFolder = Replace(Replace(strRelativePath, strOrigineFolder, ""), strCurrentFileName, "")
''retourne le nombre de fois qu'il faut remonter au répertoire parent
lngParentsFolder = Len(Replace(strGoToParentFolder, "\", "")) / 2
''détermine la valeur d'origine du répertoire du début
strPath = strCurrentProjectpath
Vérifie s 'il faut aller au répertoire parent
If lngParentsFolder < 1 Then
'si non, alors répertoire parent et répertoire d'origine du fichier
strPath = strCurrentProjectpath & "\" & strOrigineFolder
Else
''si oui, nous faisons la boucle pour retourner au répertoire d'origine
For i = 1 To lngParentsFolder
strPath = fso.GetParentFolderName(strPath)
Next i
End If
''retournons le répertoire parent du fichier et son répertoire d'origine [le OUTPUT]
AbsolutePath = strPath & strOrigineFolder & "\"
End Function