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

Question

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

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

Answer 1

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

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

Answer 2

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

ActiveWorkbook.Path
ThisWorkbook.Path
App.Path

Answer 3

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

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

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

ChDir ThisWorkbook.Path

Думаю, я бы предпочел использовать ThisWorkbook.Path для создания пути к файлу 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

Answer 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

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

Answer 5

, если текущим каталогом операционной системы является путь к книге, которую вы используете, Workbooks.Open FileName:= "TRICATEndurance Summary.html" будет достаточно. если вы производите вычисления с путем, вы можете сослаться на текущий каталог как ., а затем \, чтобы указать, что файл находится в этом каталоге, и в случае, если вам нужно изменить текущий каталог операционной системы на путь к вашей книге, вы можно использовать ChDrive и ChDir для этого.

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

Answer 6

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