Relative anstelle von Absoluten Pfaden in Excel VBA
-
03-07-2019 - |
Frage
Ich habe ein Excel-VBA-Makro geschrieben, die Daten aus einer HTML-Datei (lokal gespeichert) vor Durchführung von Berechnungen auf den Daten.
importiertIm Moment ist die HTML-Datei mit einem absoluten Pfad bezeichnet wird:
Workbooks.Open FileName:="C:\Documents and Settings\Senior Caterer\My Documents\Endurance Calculation\TRICATEndurance Summary.html"
Allerdings möchte ich einen relativen Pfad verwenden, um es zu verweisen auf absolute Gegensatz (dies ist, weil ich die Tabelle an Kollegen verteilen möchten, die nicht die gleiche Ordnerstruktur verwenden könnten). Da die HTML-Datei und die Excel-Tabelle sitzt im selben Ordner würde ich das nicht schwierig wäre gedacht haben, aber sie ist nur völlig unfähig, es zu tun. Ich habe auf dem Web durchsucht und die vorgeschlagenen Lösungen haben alle erschienen sehr kompliziert.
Ich bin mit Excel 2000 und 2002 bei der Arbeit, aber wie ich es zu verteilen, plane ich mag es so viele Versionen von Excel wie möglich arbeiten.
Alle Vorschläge dankbar angenommen.
Lösung
Nur um zu klären, was yalestar sagte, dies wird Ihnen den relativen Pfad:
Workbooks.Open FileName:= ThisWorkbook.Path & "\TRICATEndurance Summary.html"
Andere Tipps
Sie eine dieser für den relativen Pfad root verwenden:
ActiveWorkbook.Path
ThisWorkbook.Path
App.Path
ich glaube, das Problem ist, dass ohne Pfad Öffnen die Datei wird nur funktionieren, wenn Ihr „aktuelles Verzeichnis“ richtig eingestellt ist.
Versuchen „Debug.Print CurDir“ in dem Direkt-Fenster eingeben -., Dass Sie den Speicherort für Ihre Standarddateien zeigen sollte, wie sie in Tools ... Optionen
Ich bin mir nicht sicher, ob ich es ganz glücklich bin, vielleicht, weil es so etwas wie ein Vermächtnis VB-Befehl ist, aber man kann dies tun:
ChDir ThisWorkbook.Path
Ich glaube, ich würde es vorziehen, ThisWorkbook.Path zu verwenden, um einen Pfad zur HTML-Datei zu erstellen. Ich bin ein großer Fan des Filesystem in der Scripting Runtime (die immer installiert zu sein scheint), so würde ich glücklicher sein, so etwas zu tun (nach einen Verweis auf Microsoft Scripting Runtime Einstellung):
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
Sie können mehr Flexibilität, um Ihre Benutzer zur Verfügung stellen, indem liefern Browser-Taste , um sie
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
mit diesem Stück Code können Sie dies erreichen, leicht. Getestet Code
, wenn aktuelle Verzeichnis des Betriebssystems, der Pfad der Arbeitsmappe, die Sie verwenden, würde Workbooks.Open FileName:= "TRICATEndurance Summary.html"
genügen. wenn Sie Berechnungen mit dem Weg machen, Sie zu aktuellen Verzeichnis als .
beziehen und dann \
die Datei zu sagen, dass dir ist, und im Fall, dass Sie das Betriebssystem des aktuellen Verzeichnisses zu Ihrer Arbeitsmappe Pfad ändern, können Sie ChDrive
verwenden und ChDir
dies zu tun.
ChDrive ThisWorkbook.Path
ChDir ThisWorkbook.Path
Workbooks.Open FileName:= ".\TRICATEndurance Summary.html"
Ich denke, das kann helfen. Im Folgenden Makro prüft, ob Ordner vorhanden ist, wird, wenn nicht, dann den Ordner erstellen und in beiden xls und PDF-Format in einem solchen Ordner speichern. Es kommt vor, dass der Ordner mit den beteiligten Personen geteilt wird, so dass jeder aktualisiert wird.
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