Percorsi relativi anziché assoluti in VBA di Excel

Question

Ho scritto una macro VBA di Excel che importa i dati da un file HTML (archiviato localmente) prima di eseguire calcoli sui dati.

Al momento si fa riferimento al file HTML con un percorso assoluto:

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

Tuttavia, desidero utilizzare un percorso relativo per fare riferimento ad esso invece che assoluto (questo perché desidero distribuire il foglio di calcolo ai colleghi che potrebbero non utilizzare la stessa struttura di cartelle). Dato che il file html e il foglio di calcolo Excel si trovano nella stessa cartella, non avrei pensato che ciò sarebbe stato difficile, tuttavia non sono assolutamente in grado di farlo. Ho cercato sul web e le soluzioni suggerite sono apparse molto complicate.

Sto usando Excel 2000 e 2002 al lavoro, ma mentre ho intenzione di distribuirlo vorrei che funzionasse con quante più versioni di Excel possibile.

Eventuali suggerimenti ricevuti con gratitudine.

Answer 1

Solo per chiarire cosa ha detto Yalestar, questo ti darà il percorso relativo:

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

Answer 2

È possibile utilizzare uno di questi per la relativa radice del percorso:

ActiveWorkbook.Path
ThisWorkbook.Path
App.Path

Answer 3

Penso che il problema sia che l'apertura del file senza un percorso funzionerà solo se la tua " directory corrente " è impostato correttamente.

Prova a digitare " Debug.Print CurDir " nella finestra immediata - che dovrebbe mostrare la posizione dei file predefiniti come impostato in Strumenti ... Opzioni.

Non sono sicuro di esserne completamente soddisfatto, forse perché è un po 'un comando VB legacy, ma potresti farlo:

ChDir ThisWorkbook.Path

Penso che preferirei usare ThisWorkbook.Path per costruire un percorso al file HTML. Sono un grande fan di FileSystemObject in Scripting Runtime (che sembra sempre essere installato), quindi sarei più felice di fare qualcosa del genere (dopo aver impostato un riferimento a 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

Puoi fornire maggiore flessibilità ai tuoi utenti fornendo Pulsante Browser loro

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

con questo pezzo di codice puoi ottenerlo facilmente. Codice testato

Answer 5

se la directory corrente del sistema operativo è il percorso della cartella di lavoro che stai utilizzando, Workbooks.Open FileName: = " TRICATEndurance Summary.html " sarebbe sufficiente. se stai effettuando calcoli con il percorso, puoi fare riferimento alla directory corrente come . e quindi \ per dire che il file si trova in quella directory, e nel caso tu debba cambiare nella directory corrente del sistema operativo nel percorso della cartella di lavoro, è possibile utilizzare ChDrive e ChDir per farlo.

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

Answer 6

Penso che questo possa aiutare. Sotto Macro controlla se esiste una cartella, altrimenti non crea la cartella e la salva in entrambi i formati xls e pdf in tale cartella. Accade che la cartella sia condivisa con le persone coinvolte, quindi tutti vengono aggiornati.

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