Relative instead of Absolute paths in Excel VBA

问题

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

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

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.

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.

Any suggestions gratefully received.

回答1:

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

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

回答2:

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

ActiveWorkbook.Path
ThisWorkbook.Path
App.Path

回答3:

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.

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:

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):

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

回答4:

You can provide more flexibility to your users by provide Browser Button to 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

回答5:

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 ChDrive and ChDir to do so.

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

回答6:

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.

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

来源：https://stackoverflow.com/questions/213584/relative-instead-of-absolute-paths-in-excel-vba

标签

excel

vba

excel-vba

absolute-path