エクセルマクロで開いているアクセスのファイルを知る

質問

エクセル２００７です。今立ち上がっているファイルを、エクセルの表に書き出すマクロを作りたいです。
エクセル自身はいうまでもなく、ワード、パワーポイントまで成功しました。けど、アクセスだけがうまくいきません。パワーポイント用testはうまく動くのに、アクセス用testはだめなのです。

For Each アクセス文書 In アクセスアプリケーション.databases

でこけるのです。どうも、「databases」　というところが間違っていると、目星をつけました。どう書いたらいいのか教えてください。いろいろ調べましたがわかりませんでした。

Sub パワーポイント用test()
Dim パワーポイントアプリケーション As Object
Dim パワーポイント文書 As Object
Dim カウンター As Long

カウンター = 1
Range("A2").Select

On Error Resume Next
Set パワーポイントアプリケーション = GetObject(, "PowerPoint.Application")

On Error GoTo 0
If パワーポイントアプリケーション Is Nothing Then Exit Sub

For Each パワーポイント文書 In パワーポイントアプリケーション.Presentations
カウンター = カウンター + 1
Cells(カウンター, 1) = パワーポイント文書.Name
Cells(カウンター, 2) = パワーポイント文書.FullName
Next
Set パワーポイントアプリケーション = Nothing

End Sub

Sub アクセス用test()
Dim アクセスアプリケーション As Object
Dim アクセス文書 As Object
Dim カウンター As Long

カウンター = 1
Range("A2").Select

On Error Resume Next
Set アクセスアプリケーション = GetObject(, "Access.Application")

On Error GoTo 0
If アクセスアプリケーション Is Nothing Then Exit Sub

For Each アクセス文書 In アクセスアプリケーション.databases
カウンター = カウンター + 1
Cells(カウンター, 1) = アクセス文書.Name
Cells(カウンター, 2) = アクセス文書.FullName
Next
Set パワーポイントアプリケーション = Nothing

End Sub

回答No.2

nicotinism · ベストアンサー

回答ではありません・・・ガッカリされたかと思いますが読んでみてください。
自身で開いているファイルの一覧を求めるのは簡単ではないです。
GetObject では立ち上がっているインスタンスの一つしか返しません。
たとえば
当のマクロを記載したExcelファイルを立ち上げます。
エクスプローラで別のExcelファイルをダブルクリックで開きます。
この場合にはExcel.exe は一つしか立ち上がっていないので
GetObject で得られます。

が、
当のマクロを記載したExcelファイルを立ち上げます。
次に、スタートメニューからExcelを立ち上げてからファイルを開いた場合には
別のインスタンスで開いていることになります。
タスクマネージャでプロセスタブに２個のExcel.exe が確認できます。
この状態でGetObject で調べると取得できないExcelファイルがあるのを確認できます。
WordやPowerPointでも同様です。
GetObjectでは複数のインスタンスがある場合に
そのうちの一つしか得られません。

Accessの場合は、１Accessファイルに付き１個のAccessが立ち上がります。
タスクマネージャで確認してみてください。
また、リンクテーブルなどの間接的に開いている？Accessファイルのことも気になります。

そんなことは一切考えない。
ファイルを開くときは常にエクスプローラやデスクトップのファイルをダブルクリックで開いている。
Accessは常に１ファイルしか開かないなら、
Sub b()
On Error GoTo errH
Dim ACC As Object
Set ACC = GetObject(, "access.application")
Debug.Print ACC.currentproject.FullName
Set ACC = Nothing
Exit Sub
errH:
End Sub
で求められますけど、これじゃダメですよね～。
私は残念ながら、この問題を解くスキルを持ち合わせておりません。

特定のフォルダー内の使用中ファイルという条件なら別案も考えられます。
↓下手な考え・・・
Sub 始め()
　　Dim FolderPath As String

　　With Application.FileDialog(msoFileDialogFolderPicker)
　　　　If .Show = True Then
　　　　　　FolderPath = .SelectedItems(1)
　　　　End If
　　End With
　　Call InUseList(FolderPath)
End Sub

Private Sub InUseList(ByVal trgFolder As String, Optional fileCount As Long = 0)
On Error GoTo errH
　　Dim trgFile As String
　　Dim oFs As Object
　　Dim oDir As Object
　　Dim oDirSub As Object
　　Dim oFile As Object

　　Set oFs = CreateObject("Scripting.FileSystemObject")
　　Set oDir = oFs.getfolder(trgFolder)
　　Set oFile = oDir.Files

　　For Each oFile In oDir.Files
　　　　DoEvents
　　　　If oFile.Attributes <> 7 Then
　　　　　　Name oFile.Path As oFile.Path '同名でリネーム出来たら開かれていないかも
　　　　End If
　　Next

　　For Each oDirSub In oDir.SubFolders
　　　　Debug.Print oDirSub.Attributes, oDirSub.Path
　　　　Call InUseList(oDirSub.Path, fileCount)
　　Next

　　Set oFile = Nothing
　　Set oDirSub = Nothing
　　Set oDir = Nothing
　　Set oFs = Nothing
　　Exit Sub
errH:
　　If Err.Number = 75 Then　　 'パス名が無効です。←Win7 では何かで開かれているとこのエラー
　　　　'Debug.Print Err.Description, oFile.Path, oFile.Attributes
　　　　fileCount = fileCount + 1
　　　　ThisWorkbook.Sheets(1).Cells(fileCount, 1) = oFile.Path
　　End If
　　Err.Clear
　　Resume Next
End Sub

※ただ～し、単純に開かれているか否か？だけを判断していますので
OS によって開かれている（使用中）のファイルもヒットしてしまいます。orz
間違っても、『始め』で Cドライブを指定したりしないでください。
ごっそりとシートに書き込まれ、Excelも途中で「応答なし」になります。
（Ctrl + Break で止められるかもしれません）
なので検索範囲はマイドキュメント や システム/アプリの入っていない D ドライブなどに
限定されます。
また、メモ帳でテキストファイルを開いていた場合はヒットしません。
お粗末さまでした。。。

お礼

完全に解決しました。教えていただいたマクロを参考に、こんなマクロを作ったら、希望通りの結果になりました。これで、エクセル、ワード、パワーポイント、アクセスについて、現在立ち上がっているファイルの一覧表が、エクセルに表示されるようになりました。心から御礼申し上げます。

Sub アクセス用()
ActiveCell.Offset(1, 0).Range("A1").Select
On Error GoTo errH
Dim ACC As Object

Set ACC = GetObject(, "access.application")
ActiveCell.Value = ACC.currentproject.Name
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.Value = ACC.currentproject.FullName
Set ACC = Nothing
Exit Sub
errH:

End Sub

回答No.1

noname#192382

お聞きしますが、あらかじめアクセスにファイルをつくってありますか。そのファイルの名前を使い、エクセルからデータを送ることになります。

お礼

ありがとうございます。デスクトップにアクセスの「けいこ１」というファイルを置き、立ち上げているのですが、どうなおしてもだめです。

よろしくお願いします。