Excelのフルパス（＝パス＋ファイル名）を渡したら、ぽんとダイアログボックスが立ち上がって、ファイル選択したらそのExcelが開いて、そのExcelのBookオブジェクトをゲットできる。
EXCEL VBAをやりだしたとき、そんな関数が欲しかった・・・。書こうとして何回もエラーが出たので、結局あきらめてしまっていました。
その理由は、Bookオブジェクトに何かを代入するときは、必ず Set を付けてやらなければならなかった。
たった、それだけのことだった・・・。
ダイアログボックスを出して、ファイル名を返すパターンは普通に見つけられます。しかし、それは文字列を返してるだけであって、Bookオブジェクトそのものを返すパターンが、なかったんです。
これが、ありそうで、なかった。
自分の検索した範囲では見つけられなかったので、ここに書き残しておくことにします。
###そのエクセルが開いてるかどうかを判別させる関数
まず、ファイルがないのか、あるのか。ファイルがあっても「開いてるか、開いてないのか」をあらかじめ判別して置かなければなりません。
そこで、共通の関数として、そのエクセルが開いてるかどうか判別する関数を設けておきます。
' ファイルが編集可能か調べる関数
Public Function IsFileEditable(ByVal BVstr_FullPath As String) As Long
' // 戻り値：Long -1：ファイルなし 0：ファイルは使用中 1：ファイルは使用可能
Dim wb As Workbook
Dim n As Integer
If Len(Dir$(BVstr_FullPath)) = 0 Then
IsFileEditable = -1
Exit Function
End If
n = FreeFile()
On Error Resume Next
Open BVstr_FullPath For Binary Lock Read Write As #n
Close #n
IsFileEditable = IIf(Err.Number = 0, 1, 0)
On Error GoTo 0
End Function
###エクセルを開いて、そのブックオブジェクトそのものを返す関数
EXCELブックのフルパス（＝パス＋ファイル名）を渡したら、
1. そのブックがなかったら、このBookオブジェクトそのものを返し、
2. そのブックはあるけど開かれていたら、その開いているBookオブジェクトを返し、
3. そのブックがあって開かれてないなら、そのBookをオープンして、オープンしたBookオブジェクトを返す関数です。
ファイル名がずっと確定している、と仮定できる場合に使えます。
'第1引数のみ。フルパス(＝パス＋ファイル名)の文字列を渡す。
Public Function bk_fnc_OpenOrGet_BookObject(ByVal BVstr_FileFullPath As String) As Workbook
Select Case IsFileEditable(BVstr_FileFullPath)
Case -1: '見つからない場合は、このブックのオブジェクトを返す。
MsgBox "ご指定のファイル：" & vbCrLf & " " & BVstr_FileFullPath & vbCrLf _
& "が見つかりません。VBEの初期設定で名前を設定し直して下さい。", vbCritical
Set bk_fnc_OpenOrGet_BookObject = ThisWorkbook: Exit Function
Case 0: 'ファイルが既に開いているときはそのブックを返す。
Set bk_fnc_OpenOrGet_BookObject = GetObject(BVstr_FileFullPath)
Case 1: 'ファイルが存在していて、開いていない場合は、開かせてからそのブックオブジェクトを返す。
Set bk_fnc_OpenOrGet_BookObject = Workbooks.Open(BVstr_FileFullPath)
End Select
End Function
サーバーに日替わりで更新されるエクセルがあって、それをローカルにコピーし、それを開いてそのBookオブジェクトそのものを返す関数
・想定例 \\server-01\管理\日報 R01.2.3.xlsx を C:\users\desktop\日報 R01.2.3.xlsx にコピーして開く
'第1引数：パス (想定例："\\server-01\管理")
'第2引数：ファイル名の最初に必ず入っている文言 (想定例だと："日報 ")
'第3引数：コピーしたいパス (想定例："C:\users\desktop")
Public Function bk_fnc_GetBookNamebyOpenDialog_andCopyOpen(ByVal BVstr_FilePath_FileExist As String, _
ByVal BVstr_FileNameFirstPart As String, _
ByVal BVstr_FilePath_CopyDestination As String) As Workbook
Dim strFileFullPath As String 'ファイルのフルパスを格納する
Dim strOpenDialogMessage As String 'ダイアログボックスを開いたときのタイトルの文字列
Dim strOpenDialogExtensions As String 'ダイアログボックスを開いたとき選択する拡張子の文字列
Dim strFileName As String 'ファイル名だけの文字列
Dim strCopyFileFullPath As String 'コピーする先でのファイルのフルパスを格納する
Select Case BVstr_FileNameFirstPart
Case "日報 "
strOpenDialogMessage = "元にしたい " & BVstr_FileNameFirstPart & "を選んで下さい。"
strOpenDialogExtensions = "Microsoft Excelブック,*.xls?"
CreateObject("WScript.Shell").CurrentDirectory = BVstr_FilePath_FileExist
Case Else: MsgBox "指示された " & BVstr_FileNamePart & "が定義されていないので、" & vbCrLf _
& "が見つかりません。VBEの初期設定で定義を追加して下さい。", vbCritical
End Select
'想定例：\\server-01\管理\日報 R01.2.3.xlsx
strFileFullPath = Application.GetOpenFilename(strOpenDialogExtensions, , strOpenDialogMessage)
'想定例：C:\users\desktop\日報 R01.2.3.xlsx
strCopyFileFullPath = BVstr_FilePath_CopyDestination & _
Replace(strFileFullPath, BVstr_FilePath_FileExist, "")
'FileCopyステートメントは「コピー先」に同名のファイルが存在していると、そのファイルを上書きします。
'このとき確認メッセージは表示されません。よって、既に同名のファイルが開いているかどうか見なければいけません。
Select Case IsFileEditable(strCopyFileFullPath)
Case -1: '見つからない場合は、コピーしてそのブックを開く。
CreateObject("Scripting.FileSystemObject").CopyFile strFileFullPath, strCopyFileFullPath
Set bk_fnc_GetBookNamebyOpenDialog_andCopyOpen = Workbooks.Open(strCopyFileFullPath)
Case 0: 'ファイルが既に開いているときはそのブックを返すことにする。
Set bk_fnc_GetBookNamebyOpenDialog_andCopyOpen = GetObject(strCopyFileFullPath)
Case 1: 'ファイルが存在していて、開いていない場合は、上書きしてしてそのブックを開く。
CreateObject("Scripting.FileSystemObject").CopyFile strFileFullPath, strCopyFileFullPath
Set bk_fnc_GetBookNamebyOpenDialog_andCopyOpen = Workbooks.Open(strCopyFileFullPath)
End Select
End Function
こんな風に呼び出してやるだけです。だいぶ業務を効率化できました。
'サーバー内の、エクセルが存在しているパス
Dim str_Path_wb1_inServer As String
str_Path_wb1_inServer = "\\Server-01\Public\管理"
'開きたいそのエクセルの名前（ファイル名がずっと確定していると仮定できる）
Dim str_FileName_wb1_inServer As String
str_FileName_wb1_inServer = "変わらないファイル名.xlsx"
'サーバー内の、ファイル名が日毎に変わるエクセルが存在しているパス
Dim str_FilePath_wb2_inServer As String
str_FilePath_wb2_inServer = "\\Server-01\Public\管理\日報"
'開きたいそのエクセルの、名前の最初に必ず入っている文字列
Dim str_FileNameFirstPart_wb2_inServer As String
str_FileNameFirstPart_wb2_inServer = "日報 "
'そのエクセルをコピーしたいパス
Dim str_FilePath_COPY_wb2_toLocal As String
str_FilePath_COPY_wb2_toLocal = "C:\Users\Desktop\作業\集計"
'ブックの箱をセット
Dim wb1 As Workbook
Set wb1 = bk_fnc_OpenOrGet_BookObject(str_Path_wb1_inServer & "\" & str_FileName_wb1_inServer)
'ここでエラーを返してきたら、モジュールの処理自体を終了させる。
If wb1.Name = ThisWorkbook.Name Then
MsgBox "このブックは確定しないといけないので、処理をいったん終了します。"
End If
Dim wb2 As Workbook
Set wb2 = bk_fnc_GetBookNamebyOpenDialog_andCopyOpen(str_FilePath_wb2_inServer, _
str_FileNameFirstPart_wb2_inServer, _
str_FilePath_COPY_wb2_toLocal)
(最後)
Set wb1 = Nothing: Set wb2 = Nothing