for - open file vba excel

Relativo en lugar de rutas absolutas en Excel VBA

Question

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 este momento, 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 es porque quiero distribuir la hoja de cálculo a 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 hubiera pensado que esto sería difícil, sin embargo, estoy completamente incapacitado para hacerlo. He buscado en la web y las soluciones sugeridas parecen todas muy complicadas.

Estoy usando Excel 2000 y 2002 en el trabajo, pero como planeo distribuirlo, me gustaría que funcione con tantas versiones de Excel como sea posible.

Cualquier sugerencia recibida con gratitud

Answer 1

Creo que el problema es que abrir el archivo sin una ruta solo funcionará si su "directorio actual" está configurado correctamente.

Intente escribir "Debug.Print CurDir" en la ventana Inmediato, que debe mostrar la ubicación de sus archivos predeterminados como se establece en Herramientas ... Opciones.

No estoy seguro de estar completamente satisfecho con esto, quizás porque es una especie de comando VB heredado, pero podrías hacer esto:

ChDir ThisWorkbook.Path

Creo que preferiría usar ThisWorkbook.Path para construir una ruta al archivo HTML. Soy un gran admirador de FileSystemObject en Scripting Runtime (que siempre parece estar instalado), así que estaría más feliz de 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

Answer 2

Creo que esto puede ayudar. Debajo de Macro comprueba si existe una carpeta, si no la crea, la guarda y la guarda 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

Answer 3

Puede proporcionar más flexibilidad a sus usuarios al proporcionarles un 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

Answer 4

Puede usar uno de estos para la raíz de la ruta relativa:

ActiveWorkbook.Path
ThisWorkbook.Path
App.Path

Answer 5

Solo para aclarar lo que dijo yalestar, esto le dará la ruta relativa:

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