閉じたブックからデータを取得する

下記のｺｰﾄﾞになにか不足しています。
いろいろやりましたがわかりません。

Dim str As String
Dim mydic As Object
Set mydic = CreateObject("Scripting.Dictionanry")

Set wb = Workbooks("顧客管理2.xlsm")
Set ws = Worksheets("顧客マスタ")

str = wb.ws

For i = 2 To 10
mydic.Add wb.wsCells(i, 1).Value, wb.wsCells(i, 13).Value
Next i
For i = 2 To 10
Cells(i, 7).Value = mydic.Item(Cells(i, 1).Value)
Next

Set mydic = Nothing
Set wb = Nothing
Set ws = Nothing

End Sub

No.2 ベストアンサー 回答者： WindFaller 回答日時： 2018/06/27 02:47

>閉じたブックからデータを取得する

つまり、Openメソッドを使わないということですね。

いろいろやってみたということでしょうけれども、
"Scripting.Dictionanry"
は、使いません。
ADODB を使ってアクセスするのが一般的ですが、DAOでも可能なはずです。
他にも、ExecuteExcel4Macroを使って、R1C1型でデータを抜き取りという方法があります。
ちょっとしたコツが必要です。残念ながら、#1さんご紹介の中の「エクセルの真髄」には、随所に間違いや勘違いがあるようなので、こちらで直しました。

しかし、これで分かるように、Workbook Open メソッドを使わない方法というのは、どれも一筋縄ではいかない難しさが潜んでいることがおわかりにりますでしょうか。


'//ご指摘の中のコードを直してみました。500個のデータでも、1.7秒で完了します。
'//標準モジュール
Sub Sample1_2()
　Dim i As Long
　Dim j As Long
　Dim myFolder As String
　Dim fn As String
　Dim strRng As String
　Debug.Print Timer　'時間の計測用

　myFolder = Application.DefaultFilePath & "Temp1\
　fn = "10002.xls"　'2007以上のファイルでも可能
　If Dir(myFolder & fn) = "" Then MsgBox "ファイルが見当たりません。", vbExclamation: Exit Sub
　strRng = Range("A1:E100").Address(1, 1, xlR1C1) 'データ範囲
　Application.ScreenUpdating = False
　For i = 1 To 100
　 For j = 1 To 5
　　Cells(i, j).Value = ExecuteExcel4Macro("INDEX('" & myFolder & "[" & fn & "]Sheet1'!" & strRng & "," & i & "," & j & ")")
　 Next
　Next
　Application.ScreenUpdating = True
　Debug.Print Timer　'時間の計測用
End Sub
'//

'//
Sub ADODBMacro()
　'Microsoft ActiveX Data Object 2.8 Library '参照雪堤
Dim objCn As ADODB.Connection
Dim objRs As ADODB.Recordset
Dim fn As String
Dim strQuery As String
Dim myPath As String
'Dim errSign '検査用変数
Dim k As Long, i As Long
Set objCn = New ADODB.Connection
myPath = Application.DefaultFilePath & "Temp1\"
fn = "10004.xlsm" '2007以上に限ります。そうでない場合は、以下のProvider を変更します。
With objCn
　objCn.Provider = "Microsoft.ACE.OLEDB.12.0"
　objCn.Properties("Extended Properties") = "Excel 12.0"
　objCn.Open myPath & fn
End With
Set objRs = New ADODB.Recordset
strQuery = "SELECT * FROM [Sheet1$]"
k = 1
objRs.Open strQuery, objCn, adOpenKeyset, adLockOptimistic 'objcn, 1,3
objRs.MoveFirst
Do Until objRs.EOF = True
　For i = 0 To objRs.Fields.Count
　 On Error Resume Next
　 '一行目はフィールドと扱われるので、このコードでは取得できません。
　 Cells(k, i + 1).Value = objRs.Fields(i).OriginalValue
　 '数値型と文字型が混在すると、最初に決定されたもの以外は取れない
　 ''errSign = Err.Number & " ," & Err.Description '取れない場合の原因を探す
　 On Error GoTo 0
　Next
　objRs.MoveNext
　k = k + 1
　If k > 100 Then　　'100を越えたらストップ
　 Exit Do
　End If
Loop
objRs.Close
objCn.Close
End Sub
'//

'これらには一つの欠陥があります。それはデータ量が分からないということです。ADODBで、データの最後は出ていますが、それは、最後までデータを取得する必要があります。これは、ExcecExcel4Macro でも同様です。

この回答へのお礼

ありがとうございました
勉強します。

お礼日時：2018/06/27 07:50

No.1 回答者： fujillin 回答日時： 2018/06/26 15:33

こんにちは

テストしてはいませんが、実行するといろいろエラーが出るものと想像します。
まずは、エラーを除きましょう。

一方でご質問のタイトルに「閉じたブックからデータを取得する」とありますが、「顧客管理2.xlsm」は閉じた状態で実行すると想定しているのでしたら、そのままデバッグをしても動作しません。

ご提示のような読み取り方法で他の（閉じた）ブックから値を読み込みたいのであれば、まず、対象とするブックを開く必要があります。
画面に表示されるのが嫌であれば、非表示のまま開く方法もあります。
https://kokodane.com/mini_macro-57.htm
（非表示にした場合、正しく動作するまではエラー等でVBAが停止すると、アプリケーションが非表示のまま残りますので、そのあたりを理解しておく必要があります。）

あるいは、VBAからOPEN等の処理を行わずに直接値を取得したいのであれば、旧い Excel4Macro を利用するという方法もあります。
http://officetanaka.net/excel/vba/tips/tips28.htm
http://www.moug.net/tech/exvba/0060037.html
https://excel-ubara.com/excelvba5/EXCELVBA242.html


さて、ご提示のコードをざっと見た限りですが
（確認していませんので、不足や誤解があるかも知れませんがご容赦）
＞Set ws = Worksheets("顧客マスタ")
wb内のシートを取得するつもりならそうはならない。
（暗黙にActiveBookのシートが対象となる）

＞str = wb.ws
wbにブックオブジェクトが取得できているとして、Workbookオブジェクトには「ws」なるプロパティは存在しない
更に、右辺は文字列型にはなりそうもないが、文字列型のstr変数に代入しようとしている

＞mydic.Add wb.wsCells(i, 1).Value, wb.wsCells(i, 13).Value
上記同様に、Workbookには「wsCells」というプロパティは存在しない

などなど、問題はいろいろとありそうです。

※ コードだけを見ても（特に管制できていないものでは）、内容的に何をなさりたいのか理解できませんので、実際の「なさりたいこと」に対して適切な処理になっているのかどうかはわかりません。

この回答へのお礼

有難うございます。

お礼日時：2018/06/26 22:40