Относительные вместо абсолютных путей в 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» в окне Immediate - это должно показать местоположение файлов по умолчанию, как установлено в «Инструменты ... Параметры».

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

ChDir ThisWorkbook.Path 

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

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

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

Я думаю, это может помочь. Ниже 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