Excel VBA에서 Absolute 경로가 아닌 상대 경로

Excel VBA에서 Absolute 경로가 아닌 상대 경로

데이터를 계산하기 전에 HTML 파일(로컬에 저장)에서 데이터를 Import하는 Excel VBA 매크로를 작성했습니다.

현재 HTML 파일은 절대 경로로 참조됩니다.

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

그러나 절대값이 아닌 상대 경로를 사용하여 참조하고 싶습니다(이는 동일한 폴더 구조를 사용하지 않을 수 있는 동료에게 스프레드시트를 배포하고 싶기 때문입니다).html 파일과 엑셀 스프레드시트가 같은 폴더에 있기 때문에 어려울 것이라고는 생각하지 못했지만, 전혀 할 수 없습니다.제가 웹에서 검색해 봤는데, 제안된 해결책들은 모두 매우 복잡해 보였어요.

회사에서 Excel 2000과 2002를 사용하고 있습니다만, 전달을 예정하고 있기 때문에 가능한 한 많은 버전의 Excel로 대응해 주셨으면 합니다.

어떤 제안도 감사히 받아들였습니다.

yalestar가 말한 내용을 명확히 하기 위해 상대 경로를 제공합니다.

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

상대 경로 루트에 다음 중 하나를 사용할 수 있습니다.

ActiveWorkbook.Path
ThisWorkbook.Path
App.Path

문제는 "현재 디렉토리"가 올바르게 설정되어 있어야만 경로 없이 파일을 열 수 있다는 것입니다.

"디버깅"을 입력해 보십시오.[Immediate]창에서 [Print CurDir](커 Dir 인쇄) - [Tools](도구)에서 설정한 기본 파일 위치를 표시합니다.옵션들.

레거시 VB 명령어이기 때문에 완전히 만족할 수 있을지 모르겠습니다만, 다음과 같이 할 수 있습니다.

ChDir ThisWorkbook.Path

This Workbook을 사용하는 것이 좋을 것 같습니다.HTML 파일에 대한 경로를 구성하는 경로입니다.스크립팅 런타임(항상 설치되어 있는 것처럼 보이는) 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

운영 체제의 현재 디렉토리가 사용 중인 워크북의 경로인 경우,Workbooks.Open FileName:= "TRICATEndurance Summary.html"충분할 거야패스로 계산하고 있는 경우는, 현재의 디렉토리를 다음과 같이 참조할 수 있습니다..그리고 나서.\파일이 그 dir에 있고, OS의 현재 디렉토리를 워크북의 경로로 변경해야 할 경우 다음을 사용할 수 있습니다.ChDrive그리고.ChDir그렇게 하기 위해서.

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

사용자에게 브라우저 버튼을 제공함으로써 사용자에게 더 많은 유연성을 제공할 수 있습니다.

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:=GetAbsolutePath("..\..\TRICATEndurance Summary.html")

코드:

' 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

이게 도움이 될 것 같아아래 매크로에서는 폴더가 존재하는지 확인합니다.그러면 폴더가 생성되지 않고 해당 폴더에 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

그것은 아마도 그것을 하는 최선의 방법이 아닐 것이다.그러나 Absolute 경로를 얻을 수 있는 유일한 방법은 구문 횟수를 계산하는 것입니다.는 스트링에 포함되어 있으며 하이퍼링크주소로 구문이 입력되는 횟수만큼 gotoparent 함수를 사용합니다.(내 경우 필드는 하이퍼링크주소입니다.추신: 이 코드에는 Microsoft 스크립팅 런타임에 대한 참조가 필요합니다.

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

언급URL : https://stackoverflow.com/questions/213584/relative-instead-of-absolute-paths-in-excel-vba