Относительный, а не абсолютный путь в Excel VBA

Я написал макрос 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.

Любые предложения с благодарностью получены.

Ответ 1

Чтобы уточнить, что сказал yalestar, это даст вам относительный путь:

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

Ответ 2

Вы можете использовать один из них для относительного корня пути:

ActiveWorkbook.Path
ThisWorkbook.Path
App.Path

Ответ 3

Я думаю, проблема в том, что открытие файла без пути будет работать, только если ваш "текущий каталог" установлен правильно.

Попробуйте ввести "Debug.Print CurDir" в окне "Немедленное" - это должно показать местоположение файлов по умолчанию, как указано в "Инструменты...".

Я не уверен, что полностью этому доволен, возможно, потому, что это часть устаревшей команды VB, но вы можете сделать это:

ChDir ThisWorkbook.Path

Я думаю, что я предпочел бы использовать ThisWorkbook.Path для создания пути к HTML файлу. Я большой поклонник FileSystemObject в Runtime Scripting (который всегда кажется установленным), поэтому я был бы счастливее сделать что-то вроде этого (после установки ссылки на 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

Вы можете обеспечить большую гибкость для своих пользователей, предоставив им кнопку браузера

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

с этим фрагментом кода вы можете легко достичь этого. Протестированный код

Ответ 5

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

Ответ 6

Я думаю, это может помочь. Ниже Macro проверяет, существует ли папка, если нет, то создайте папку и сохраните в обоих форматах 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