Rutas relativas en lugar de rutas absolutas en Excel VBA
-
03-07-2019 - |
Pregunta
He escrito una macro de Excel VBA que importa datos de un archivo HTML (almacenado localmente) antes de realizar cálculos en los datos.
En el momento en que se hace referencia al archivo HTML con una ruta absoluta:
Workbooks.Open FileName:="C:\Documents and Settings\Senior Caterer\My Documents\Endurance Calculation\TRICATEndurance Summary.html"
Sin embargo, quiero usar una ruta relativa para referirme a ella en lugar de absoluta (esto se debe a que quiero distribuir la hoja de cálculo a los colegas que podrían no usar la misma estructura de carpetas). Como el archivo html y la hoja de cálculo de Excel se encuentran en la misma carpeta, no habría pensado que esto sería difícil, sin embargo, soy completamente incapaz de hacerlo. He buscado en la web y las soluciones sugeridas han aparecido muy complicadas.
Estoy utilizando Excel 2000 y 2002 en el trabajo, pero como planeo distribuirlo, me gustaría que funcione con la mayor cantidad de versiones de Excel posible.
Cualquier sugerencia recibida con gratitud.
Solución
Solo para aclarar lo que dijo yalestar, esto te dará la ruta relativa:
Workbooks.Open FileName:= ThisWorkbook.Path & "\TRICATEndurance Summary.html"
Otros consejos
Podrías usar uno de estos para la raíz de ruta relativa:
ActiveWorkbook.Path
ThisWorkbook.Path
App.Path
Creo que el problema es que abrir el archivo sin una ruta solo funcionará si tu " directorio actual " está configurado correctamente.
Intente escribir " Debug.Print CurDir " en la ventana Inmediato, que debe mostrar la ubicación de sus archivos predeterminados según lo establecido en Herramientas ... Opciones.
No estoy seguro de estar completamente contento con eso, quizás porque es un comando VB heredado, pero puedes hacer esto:
ChDir ThisWorkbook.Path
Creo que preferiría usar ThisWorkbook.Path para construir una ruta al archivo HTML. Soy un gran fan de FileSystemObject en Scripting Runtime (que siempre parece estar instalado), así que me encantaría hacer algo como esto (después de establecer una referencia 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
Puede proporcionar más flexibilidad a sus usuarios al proporcionarles Botón del navegador
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 esta pieza de código puedes lograr esto, fácilmente. Código probado
si el directorio actual del sistema operativo es la ruta del libro de trabajo que está utilizando, Workbooks.Open FileName: = " TRICATEndurance Summary.html "
sería suficiente. Si está haciendo cálculos con la ruta, puede referirse al directorio actual como .
y luego \
para indicar que el archivo está en ese directorio, y en caso de que tenga que cambiar el directorio actual del sistema operativo a la ruta de su libro de trabajo, puede usar ChDrive
y ChDir
para hacerlo.
ChDrive ThisWorkbook.Path
ChDir ThisWorkbook.Path
Workbooks.Open FileName:= ".\TRICATEndurance Summary.html"
Creo que esto puede ayudar. A continuación, Macro comprueba si la carpeta existe, si no crea la carpeta y guárdela en formatos xls y pdf en dicha carpeta. Sucede que la carpeta se comparte con las personas involucradas para que todos estén actualizados.
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