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