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

StackOverflow https://stackoverflow.com/questions/213584

题

我编写了一个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版本一起使用。

感激地收到任何建议。

有帮助吗？

解决方案

为了澄清耶鲁星所说的话，这会给你相对路径：

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

其他提示

您可以将其中一个用于相对路径根目录：

ActiveWorkbook.Path
ThisWorkbook.Path
App.Path

我认为问题在于，打开没有路径的文件只有在你的“当前目录”中才能使用。设置正确。

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

我不确定我是否对此感到满意，也许是因为它有点像传统的VB命令，但你可以这样做：

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：=＆quot; TRICATEndurance Summary.html＆quot; 就足够了。如果你使用路径进行计算，你可以将当前目录称为。然后 \ 来告诉该文件在该目录中，以防你需要更改os的当前目录到工作簿的路径，您可以使用 ChDrive 和 ChDir 来执行此操作。

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

我认为这可能会有所帮助。下面的宏检查文件夹是否存在，如果没有，则创建文件夹并以这种文件夹中的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
许可以下： CC-BY-SA 和 归因
不隶属于 StackOverflow
scroll top