Excel VBA中的相对而不是绝对path

我已经写了一个Excel VBAmacros,它在对数据执行计算之前从HTML文件(本地存储)导入数据。

目前HTML文件被称为绝对path:

Workbooks.Open FileName:="C:\Documents and Settings\Senior Caterer\My Documents\Endurance Calculation\TRICATEndurance Summary.html" 

不过,我想用相对path来引用它,而不是绝对的(这是因为我想将电子表格分发给可能不使用相同文件夹结构的同事)。 由于HTML文件和Excel电子表格坐在同一个文件夹,我不会觉得这将是困难的,但是我完全无法做到这一点。 我在网上search,所build议的解决scheme都显得非常复杂。

我在工作中使用Excel 2000和2002,但是因为我打算分发它,所以我希望它能够尽可能多的使用Excel版本。

任何build议感激地收到。

只是为了澄清耶鲁之星说的话,这会给你相对的path:

 Workbooks.Open FileName:= ThisWorkbook.Path & "\TRICATEndurance Summary.html" 

你可以使用其中的一个作为相对path根:

 ActiveWorkbook.Path ThisWorkbook.Path App.Path 

我认为问题是打开没有path的文件只有当你的“当前目录”设置正确。

尝试在即时窗口中input“Debug.Print CurDir” – 应显示工具…选项中设置的默认文件的位置。

我不确定我是否完全满意,也许是因为它是一个传统的VB命令,但你可以这样做:

 ChDir ThisWorkbook.Path 

我想我更喜欢使用ThisWorkbook.Path来构buildHTML文件的path。 我是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 

通过向用户提供浏览器button ,可以为用户提供更多的灵活性

 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 

用这段代码你可以轻松实现这一点。 testing过的代码

我认为这可能有帮助。 下面的macros检查文件夹是否存在,如果没有,则创build文件夹,并在这种文件夹中保存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