Excel VBAの絶対パスではなく相対パス

StackOverflow https://stackoverflow.com/questions/213584

質問

データの計算を実行する前に、HTMLファイル（ローカルに保存されている）からデータをインポートするExcel VBAマクロを作成しました。

現時点では、HTMLファイルは絶対パスで参照されます：

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

ただし、絶対パスではなく相対パスを使用して参照します（これは、同じフォルダー構造を使用していない可能性がある同僚にスプレッドシートを配布するためです）。 htmlファイルとExcelスプレッドシートは同じフォルダーにあるため、これが難しいとは思っていませんでしたが、それを完全に行うことはできません。私はウェブで検索しましたが、提案された解決策はすべて非常に複雑に見えました。

Excel 2000および2002を職場で使用していますが、配布する予定があるため、できるだけ多くのバージョンのExcelで動作するようにしたいと考えています。

すべての提案に感謝します。

役に立ちましたか？

解決

yalestarが言ったことを明確にするために、これは相対パスを提供します：

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

他のヒント

相対パスルートに次のいずれかを使用できます。

ActiveWorkbook.Path
ThisWorkbook.Path
App.Path

問題は、パスなしでファイルを開くことができるのは、「現在のディレクトリ」が正しく設定されています。

＆quot; Debug.Print CurDir＆quot;と入力してみてください。イミディエイトウィンドウ-ツール...オプションで設定されたデフォルトファイルの場所が表示されます。

それが完全に満足しているのかどうかはわかりません。おそらくそれはレガシーVBコマンドのせいかもしれませんが、次のようにすることができます。

ChDir ThisWorkbook.Path

ThisWorkbook.Pathを使用してHTMLファイルへのパスを作成したいと思います。私はScripting Runtime（常にインストールされているようです）のFileSystemObjectの大ファンなので、（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

ブラウザボタンをユーザーに提供することで、ユーザーに柔軟性を提供できます

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

このコードを使用すると、簡単にこれを実現できます。 テスト済みコード

オペレーティングシステムの現在のディレクトリが使用しているワークブックのパスである場合、 Workbooks.Open FileName：=＆quot; TRICATEndurance Summary.html＆quot; で十分です。パスを使用して計算している場合、現在のディレクトリを。として参照し、次に \ を使用して、ファイルがそのディレクトリにあることを確認できます。 osの現在のディレクトリをワークブックのパスに移動するには、 ChDrive と ChDir を使用します。

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

私はこれが役立つと思う。以下のマクロは、フォルダーが存在するかどうかをチェックし、存在しない場合はフォルダーを作成し、そのようなフォルダーにxlsおよびpdf形式の両方で保存します。フォルダーが関係者と共有されるため、全員が更新されます。

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
ライセンス： CC-BY-SA と 帰属
所属していません StackOverflow
scroll top