Excel VBA 中的相对路径而不是绝对路径

Relative instead of Absolute paths in Excel VBA

提问by Gene

I have written an Excel VBA macro which imports data from a HTML file (stored locally) before performing calculations on the data.

我编写了一个 Excel VBA 宏，它在对数据执行计算之前从 HTML 文件（本地存储）导入数据。

At the moment the HTML file is referred to with an absolute path:

目前使用绝对路径引用 HTML 文件：

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

However I want to use a relative path to refer to it as opposed to absolute (this is because I want to distribute the spreadsheet to colleagues who might not use the same folder structure). As the html file and the excel spreadsheet sit in the same folder I would not have thought this would be difficult, however I am just completely unable to do it. I have searched on the web and the suggested solutions have all appeared very complicated.

但是，我想使用相对路径而不是绝对路径来引用它（这是因为我想将电子表格分发给可能不使用相同文件夹结构的同事）。由于 html 文件和 excel 电子表格位于同一个文件夹中，我不会认为这会很困难，但是我完全无法做到。我在网上搜索过，建议的解决方案都显得非常复杂。

I am using Excel 2000 and 2002 at work, but as I plan to distribute it I would want it to work with as many versions of Excel as possible.

我在工作中使用 Excel 2000 和 2002，但是当我计划分发它时，我希望它能够与尽可能多的 Excel 版本一起使用。

Any suggestions gratefully received.

任何建议都非常感谢。

回答by dbb

Just to clarify what yalestar said, this will give you the relative path:

只是为了澄清 yalestar 所说的，这将为您提供相对路径：

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

回答by yalestar

You could use one of these for the relative path root:

您可以将其中之一用于相对路径根：

ActiveWorkbook.Path
ThisWorkbook.Path
App.Path

回答by Mike Woodhouse

I think the problem is that opening the file without a path will only work if your "current directory" is set correctly.

我认为问题是打开没有路径的文件只有在您的“当前目录”设置正确时才有效。

Try typing "Debug.Print CurDir" in the Immediate Window - that should show the location for your default files as set in Tools...Options.

尝试在立即窗口中键入“Debug.Print CurDir” - 这应该显示在工具...选项中设置的默认文件的位置。

I'm not sure I'm completely happy with it, perhaps because it's somewhat of a legacy VB command, but you could do this:

我不确定我对它是否完全满意，也许是因为它有点像一个遗留的 VB 命令，但你可以这样做：

ChDir ThisWorkbook.Path

I think I'd prefer to use ThisWorkbook.Path to construct a path to the HTML file. I'm a big fan of the FileSystemObject in the Scripting Runtime (which always seems to be installed), so I'd be happier to do something like this (after setting a reference to Microsoft Scripting Runtime):

我想我更喜欢使用 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

回答by robotik

if current directory of the operating system is the path of the workbook you are using, Workbooks.Open FileName:= "TRICATEndurance Summary.html"would suffice. if you are making calculations with the path, you can refer to current directory as .and then \to tell the file is in that dir, and in case you have to change the os's current directory to your workbook's path, you can use ChDriveand ChDirto do so.

如果操作系统的当前目录是您正在使用的工作簿的路径，Workbooks.Open FileName:= "TRICATEndurance Summary.html"就足够了。如果您正在使用路径进行计算，您可以引用当前目录.，然后\告诉文件在该目录中，如果您必须将操作系统的当前目录更改为您的工作簿的路径，您可以使用ChDrive和ChDir这样做.

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

回答by Simpal Kumar

You can provide more flexibility to your users by provide Browser Buttonto them

您可以通过向用户提供浏览器按钮来为他们提供更大的灵活性

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

with this piece of code you can achieve this, easily. Tested code

使用这段代码，您可以轻松实现这一目标。测试代码

回答by Lurds

i think this may help. Below Macro checks if folder exists, if does not then create the folder and save in both xls and pdf formats in such folder. It happens that the folder is shared with the involved people so everybody is updated.

我认为这可能会有所帮助。下面的宏检查文件夹是否存在，如果不存在则创建文件夹并以 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