【VBA】カレントフォルダを別フォルダに変更する

こんにちは、Ryoです。
Excelを扱う中で例えばファイルを開こうとする操作の際に、Excel側で設定されたフォルダがカレントフォルダとして開くわけですが、そのフォルダを変えたい場合に都度変える作業を煩わしく思うことがありますよね。そこで今回はそのカレントフォルダやドライブを変更（設定）する方法について書いていこうと思います。

1.サンプル概要
2.サンプルコード
3.まとめ

1.サンプル概要

サンプルで起動中のExcelでは、現在のカレントフォルダが「D:\デスクトップ」となっています。先ずはこの現フォルダ名を表示し、その後Cドライブの「C:\temp」へ変更し、再度メッセージボックスで表示するものです。

この状態からCドライブへの変更、及びフォルダの変更を実行し再度メッセージボックスで表示させると以下となり、変更されていることがわかります。

ちなみに私がよく使うショートカット「Ctrl+F12」で「ファイルを開く」ダイアログを表示させるものがありますので、参考までにショートカットをSendKeysメソッドで実行し変更内容を確認したものも後述したいと思います。

では、これらの内容について書いていきます。

2.サンプルコード

◆カレントドライブやフォルダの変更

Sub Sample1()

 Dim Sample_fol As String
 
 '現在のカレントフォルダ名を変数に代入
 '本例では"D:\デスクトップ"です
 Sample_fol = CurDir
 
 '現在のカレントフォルダ名をメッセージボックスで表示
 MsgBox "現在のカレントフォルダ：" & CurDir & vbCrLf & _
 "　⇒これを別のフォルダに変更します"
 
 '本例ではDからCドライブのフォルダを指定しますので、
 '「カレントドライブ変更」⇒「カレントフォルダ変更」
 ChDrive "C"      'Cドライブへ変更
 ChDir "C:\temp"  'フォルダを指定し変更
 
 '＊＊注記＊＊
 '同カレントドライブ上であればChDir "Path"で変更できますが
 '本例のように別ドライブに変更したい場合は最初にドライブを
 'ChDrive "C"のように指定後、ChDirでPathを指定しなければ
 '変更できませんのでご注意ください
 '＊＊＊＊＊＊
 
 '変更後のカレントフォルダ名表示
 MsgBox "変更したカレントフォルダ：" & CurDir & vbCrLf & _
 "　⇒D:\デスクトップからC:\tempに変更しました"
 
 'ここではカレントドライブ・フォルダを元に戻します
 ChDrive "D"       'Dドライブへ変更
 ChDir Sample_fol  '最初に読み込んだカレントフォルダを指定

End Sub

先ずは現在Excelが作業しているフォルダのカレントフォルダを取得しますので、その場合はCurDir関数を使用します。

構文　CurDir path

引数pathには対象となるドライブを指定するのですが省略することもできます。その場合はカレントドライブが対象になります。（例：ドライブ指定する場合はCurDir(“C”)）

その後メッセージボックスで現在のカレントフォルダ（サンプルではD:\デスクトップ）名を表示させています。

次にドライブ、及びフォルダを変更します。ドライブを変更する場合はChDriveステートメント、フォルダを変更する場合はChDirステートメントをそれぞれ使用します。

構文　ChDrive　drive

ChDriveステートメントはカレントドライブを変更するもので、引数driveに変更先のドライブ名を指定します。サンプルではCドライブにしますので、ChDrive “C”としています。

構文　ChDir pathname

ChDirステートメントはカレントフォルダを変更するもので、引数pathnameに変更後のフォルダをフルパスで指定します。

また、サンプルコード内の注記にも書いていますが、変更したいフォルダがドライブを跨るような場合はChDriveでドライブ変更が必要で、同ドライブ内のフォルダへ変更する場合ならChDirのみでOKです。

後はサンプルとして変更したカレントドライブとフォルダを元に戻す処理をして終了です。

【参考】ドライブ／フォルダ変更の確認＆SendKeys活用

ドライブやフォルダを変更した後に、実際ダイアログ表示をさせて変わっているかどうかを確認しようと思い、作ったSampleこちらになります。

ちなみにSendKeysメソッドの特性上、VBEから起動すると正常動作しませんのでSheet上にボタンを設置し、そこから起動しています。

Sub Sample2()
   'カレントドライブ・フォルダをそれぞれ指定
   ChDrive "D"
   ChDir "D:\デスクトップ"
 
  '現在のカレントフォルダ名をメッセージボックスで表示
   MsgBox "現在のカレントフォルダ：" & CurDir & vbCrLf & _
   "　⇒「ファイルを開く」ダイアログを表示します"
   
   'Ctrl + F12キーをVBA側で実行＝「ファイルを開く」
   SendKeys "^{F12}", True
   
   '＊＊注記＊＊
   'SendKeysメソッドは、アクティブなアプリケーションに
   'キーコードを転送するので、VBE上から実行しても動作
   'しませんので、Excel側から動作させます。
   '＊＊＊＊＊＊
 
End Sub

まずDドライブ設定、及びフォルダ指定後にメッセージボックスが表示され、「OK」を押すと次に「ファイルを開く」ダイアログが表示されます。

同様にCドライブ設定、フォルダ変更を実施したものがこちらです。

Sub Sample3()
   'カレントドライブ・フォルダをそれぞれ指定
   ChDrive "C"
   ChDir "C:\temp"
 
  '現在のカレントフォルダ名をメッセージボックスで表示
   MsgBox "現在のカレントフォルダ：" & CurDir & vbCrLf & _
   "　⇒「ファイルを開く」ダイアログを表示します"
   
   'Ctrl + F12キーをVBA側で実行＝「ファイルを開く」
   SendKeys "^{F12}", True
   
   '＊＊注記＊＊
   'SendKeysメソッドは、アクティブなアプリケーションに
   'キーコードを転送するので、VBE上から実行しても動作
   'しませんので、Excel側から動作させます。
   '＊＊＊＊＊＊
 
End Sub

この通り「ファイルを開く」ダイアログはしっかり変わってくれています。「名前を付けて保存」ダイアログはOffice2016で確認してる限り、作業中ブックの保存先Pathが優先されてしまうようでうまく動作しないようです。この辺りは今後時間あれば調べておこうと思います。

◆SendKeysの注意点

本題から反れるのでSendKeysについて多くは語りませんが、これにはバグがあって上のSample2やSample3を実行した後はNum Lock解除されてしまうのです。再度NumLockキーを手で押せば良いのですが、煩わしいですよね。

その場合はWindows Script HostオブジェクトモデルのWshShellオブジェクトのSendKeys Methodを使うことで解消できます。

≪Dドライブ／フォルダ変更サンプルコード≫

Sub Sample4()
   Dim wsh As Object
   Set wsh = CreateObject("wscript.shell")
   
   ChDrive "D"
   ChDir "D:\デスクトップ"
 
   MsgBox "現在のカレントフォルダ：" & CurDir & vbCrLf & _
   "　⇒「ファイルを開く」ダイアログを表示します"
   
   wsh.SendKeys "^{F12}", True
   Set wsh = Nothing
 
End Sub

≪Cドライブ／フォルダ変更　サンプルコード≫

Sub Sample5()
   Dim wsh As Object
   Set wsh = CreateObject("wscript.shell")
   
   ChDrive "C"
   ChDir "C:\temp"

   MsgBox "現在のカレントフォルダ：" & CurDir & vbCrLf & _
   "　⇒「ファイルを開く」ダイアログを表示します"
   
   wsh.SendKeys "^{F12}", True
   Set wsh = Nothing
 
End Sub

このサンプルコードのような形で実行すればNumLock解除されるようなことにはならないようなので、ご参考までに。

自動化する上で何かと役に立つSendKeysについて参考までに触れてみました。機会があればもう少し活用など色々書いてみたいと思います。