CODEWITHSUNDEEP
vbaexcelabsolute-path
Gene
Gene

Reputation: 655

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.

Upvotes: 53

Views: 206000

Answers (8)

Petter
Petter

Reputation: 341

Here's my quick and simple function for getting the absolute path from a relative path.

The difference from the accepted answer is that this function can handle relative paths that moves up to parent folders.

Example:

Workbooks.Open FileName:=GetAbsolutePath("..\..\TRICATEndurance Summary.html")

Code:

' Gets an absolute path from a relative path in the active workbook
Public Function GetAbsolutePath(relativePath As String) As String
    
    Dim absPath As String
    Dim pos As Integer
    
    absPath = ActiveWorkbook.Path
    
    ' Make sure paths are in correct format
    relativePath = Replace(relativePath, "/", "\")
    absPath = Replace(absPath, "/", "\")
    
    Do While Left$(relativePath, 3) = "..\"
    
        ' Remove level from relative path
        relativePath = Mid$(relativePath, 4)
        
        ' Remove level from absolute path
        pos = InStrRev(absPath, "\")
        absPath = Left$(absPath, pos - 1)
    
    Loop
    
    GetAbsolutePath = PathCombine(absPath, relativePath)
    
End Function

Upvotes: 0

Paul
Paul

Reputation: 1

It maybe is not the best way to do it. But the only I found to get the Absolute path is to calculate how many times the syntax .. was in the string and then use the function gotoparent as many times that syntax comes in the hyperlink adress. (in my case, my field is a hyperlink address. Ps: This code requires the reference to microsoft scripting runtime

Function AbsolutePath(strRelativePath As String, strCurrentFileName As String) As String
Dim fso As Object
Dim strCurrentProjectpath As String
Dim strGoToParentFolder As String
Dim strOrigineFolder As String
Dim strPath As String
Dim lngParentFolder As Long


''Pour retrouver le répertoire parent
Set fso = CreateObject("Scripting.FileSystemObject")

'' détermine le répertire du projet actif
strCurrentProjectpath = CurrentProject.Path

'' détermine le nom du répertoire dans lequel le fichier d'origine se trouve
strOrigineFolder = Replace(Replace(Replace(strRelativePath, strCurrentFileName, ""), "..", ""), "\", "")

''Extraction du chemin relatif (ex. ..\..\..)
strGoToParentFolder = Replace(Replace(strRelativePath, strOrigineFolder, ""), strCurrentFileName, "")

''retourne le nombre de fois qu'il faut remonter au répertoire parent
lngParentsFolder = Len(Replace(strGoToParentFolder, "\", "")) / 2

''détermine la valeur d'origine du répertoire du début
strPath = strCurrentProjectpath

Vérifie s 'il faut aller au répertoire parent
If lngParentsFolder < 1 Then
    'si non, alors répertoire parent et répertoire d'origine du fichier
    strPath = strCurrentProjectpath & "\" & strOrigineFolder
Else
    ''si oui, nous faisons la boucle pour retourner au répertoire d'origine
    For i = 1 To lngParentsFolder
        strPath = fso.GetParentFolderName(strPath)
    Next i
End If

''retournons le répertoire parent du fichier et son répertoire d'origine [le OUTPUT]
AbsolutePath = strPath & strOrigineFolder & "\"

End Function

Upvotes: -2

robotik
robotik

Reputation: 2007

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"

Upvotes: 2

Lurds
Lurds

Reputation: 1

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

Upvotes: -2

SK.
SK.

Reputation: 4358

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

Upvotes: 1

dbb
dbb

Reputation: 2877

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

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

Upvotes: 82

Mike Woodhouse
Mike Woodhouse

Reputation: 52326

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

Upvotes: 2

yalestar
yalestar

Reputation: 9564

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

ActiveWorkbook.Path
ThisWorkbook.Path
App.Path

Upvotes: 23

Related Questions