excel - vbaを使用して現在の作業ディレクトリを取得するには?

Question

私は MS Excel 2010 を使用しており、以下のコードを使用して現在のディレクトリを取得しようとしています。

    path = ActiveWorkbook.Path

ただし、 ActiveWorkbook.Path は空白を返します。

Answer 1

私はこれをテストしました：

Excel ドキュメントを開くと、次のようになりますD:\db\tmp\test1.xlsm。

• CurDir()戻り値C:\Users\[username]\Documents

• ActiveWorkbook.Path戻り値D:\db\tmp

CurDir()システムのデフォルトがあり、変更できます。

ActiveWorkbook.Path同じ保存されたワークブックでは変更されません。

たとえば、CurDir()「ファイル/名前を付けて保存」コマンドを実行し、ファイル/ディレクトリ選択ダイアログでランダムなディレクトリを選択すると変更されます。次に、[キャンセル] をクリックして保存をスキップします。しかしCurDir()、すでに最後に選択されたディレクトリに変更されています。

Answer 2

探しているものに応じて、いくつかのオプションがあります。 Workbook.Path保存されたワークブックのパスを返します。Application.PathExcel 実行可能ファイルへのパスを返します。CurDir現在の作業パスを返します。これはおそらく、デフォルトで My Documents フォルダーなどになります。

Windows スクリプト シェル オブジェクトの .CurrentDirectory プロパティを使用することもできます。

Set wshell = CreateObject("WScript.Shell")
Debug.Print wshell.CurrentDirectory

しかし、それはちょうど同じ結果を得るはずです

Debug.Print CurDir

Answer 3

ActiveWorkbook が保存されていない可能性があります...

CurDir()代わりに試してください。

Answer 4

Application.ActiveWorkbook.Pathパス自体 (ワークブック名​​なし) またはワークブック名​​を含むパスに使用Application.ActiveWorkbook.FullNameします。

Answer 5

これらのコードを使用してお楽しみください。

Public Function GetDirectoryName(ByVal source As String) As String()
Dim fso, oFolder, oSubfolder, oFile, queue As Collection
Set fso = CreateObject("Scripting.FileSystemObject")
Set queue = New Collection

Dim source_file() As String
Dim i As Integer        

queue.Add fso.GetFolder(source) 'obviously replace

Do While queue.Count > 0
    Set oFolder = queue(1)
    queue.Remove 1 'dequeue
    '...insert any folder processing code here...
    For Each oSubfolder In oFolder.SubFolders
        queue.Add oSubfolder 'enqueue
    Next oSubfolder
    For Each oFile In oFolder.Files
        '...insert any file processing code here...
        'Debug.Print oFile
        i = i + 1
        ReDim Preserve source_file(i)
        source_file(i) = oFile
    Next oFile
Loop
GetDirectoryName = source_file
End Function

そして、ここで関数を呼び出すことができます：

Sub test()
Dim s
For Each s In GetDirectoryName("C:\New folder")
Debug.Print s
Next
End Sub