Parente em vez de caminhos absolutos no Excel VBA

Question

Escrevi uma macro do Excel VBA que importa dados de um arquivo HTML (armazenado localmente) antes de executar cálculos nos dados.

No momento, o arquivo HTML é referido com um caminho absoluto:

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

No entanto, quero usar um caminho relativo para me referir a ele em oposição ao absoluto (isso ocorre porque eu quero distribuir a planilha a colegas que podem não usar a mesma estrutura de pastas). Como o arquivo HTML e a planilha do Excel sentam -se na mesma pasta, eu não pensaria que isso seria difícil, no entanto, sou completamente incapaz de fazê -lo. Eu pesquisei na web e as soluções sugeridas pareceram muito complicadas.

Estou usando o Excel 2000 e 2002 no trabalho, mas, como pretendo distribuí -lo, gostaria que trabalhasse com o maior número possível de versões do Excel.

Quaisquer sugestões recebidas com gratidão.

Answer 1

Só para esclarecer o que Yalestar disse, isso lhe dará o caminho relativo:

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

Answer 2

Você pode usar um desses para a raiz do caminho relativo:

ActiveWorkbook.Path
ThisWorkbook.Path
App.Path

Answer 3

Eu acho que o problema é que abrir o arquivo sem um caminho funcionará apenas se o seu "diretório atual" estiver definido corretamente.

Tente digitar "Debug.print Curdir" na janela imediata - que deve mostrar o local para seus arquivos padrão, conforme definido em ferramentas ... opções.

Não tenho certeza se estou completamente feliz com isso, talvez porque seja um comando VB herdado, mas você pode fazer isso:

ChDir ThisWorkbook.Path

Eu acho que prefiro usar o thisworkbook.path para construir um caminho para o arquivo HTML. Sou um grande fã do FileSystemObject no tempo de execução do script (que sempre parece estar instalado), então ficaria mais feliz em fazer algo assim (depois de definir uma referência ao tempo de execução do Microsoft Script):

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

Você pode fornecer mais flexibilidade aos seus usuários, forneça Botão do navegador para eles

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

Com este código, você pode conseguir isso, facilmente. Código testado

Answer 5

Se o diretório atual do sistema operacional for o caminho da pasta de trabalho que você está usando, Workbooks.Open FileName:= "TRICATEndurance Summary.html" seria suficiente. Se você estiver fazendo cálculos com o caminho, pode consultar o diretório atual como . e depois \ Para dizer que o arquivo está nesse dir e, caso você precise alterar o diretório atual do sistema operacional para o caminho da sua pasta de trabalho, você pode usar ChDrive e ChDir fazer isso.

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

Answer 6

Eu acho que isso pode ajudar. Abaixo, a macro verifica se a pasta existe, se não, crie a pasta e salve nos formatos XLS e PDF nessa pasta. Acontece que a pasta é compartilhada com as pessoas envolvidas, para que todos sejam atualizados.

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