Access VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

1391 / 9994

←次へ　｜　前へ→


	【11901】アクセスからエクセルファイルを扱う方法

かな - 11/1/6(木) 16:38 -


	引用なし

	パスワード

アクセスから指定エクセルファイルを開きます
↓
エクセルには、アクセスにインポートさせたいファイル名の一覧情報があります
それを配列に入れて、情報取得します
↓
順番に、アクセスのテーブルへインポートさせる

というマクロを組んでいますが、
どうしても、

一箇所だけうまくいかなくて困っています
どうかアドバイスをいただけるとありがたいです

Dim myFolder As String　　　　　　　　　'パス格納
Dim myName As String　　　　　　　　　　'検索条件格納
Dim tmpName As String
Dim objE As Object
Dim FileKey()　　　　’ファイル名の配列
Dim MaxR As Integer　’最終行の取得

　Set objE = CreateObject("Excel.Application")
　objE.Visible = True
　objE.UserControl = True

　　
　　myName = "test"　　　 'ファイル名の一部指定
　　myName = "*" & myName & "*.xls"　　　　 'Excelファイル指定
　　
　　With Application.FileSearch
　　　　.NewSearch　　　　　　　　　　　　　'前回の条件をクリア
　　　　.LookIn = "C:\TEST1\"　　　　　　　　　'検索フォルダ指定
　　　　.SearchSubFolders = True　　　　　　'サブフォルダも含む
　　　　.FileName = myName
　　　　If .Execute() > 0 Then
　　　　　 For i = 1 To .FoundFiles.Count
　　　　　　　　objE.Workbooks.Open FileName:=.FoundFiles(i)
　　　　　　　　MyFile = objE.activeworkbook.Name
　　　　　 Next i
　　　　
　　　　　 With objE.Workbooks(MyFile).sheets(1)
　　　　’★問題の箇所です↓
　　　　　　”オブジェクトがありません”
　　　　　　とｴﾗｰﾒｯｾｰｼﾞがでてしまいます
　　　　　　　
　　　　　　 MaxR = .Range("B" & rows.Count).end(xlup).row
　　　　　　
　　　　　’　しかし、変数"MaxR"の代わりに、数字を指定して進めると、
　　　　　　　下記の部分からは、うまく処理ができるのです
　　　　　’　何がよくないのでしょうか？　
　　　　　’　下記も、同じように
　　　　　’　.Range 　と記述しているのですが･･･　

　　　　　　 ReDim FileKey(MaxR - 5, 1)

　　　　　　 For i = 5 To MaxR
　　　　　　　 If .Range("B" & i).Value Like "-9_Sec43" & "*" Then
　　　　　　　　　FileKey(i - 5, 0) = Left(.Range("B" & i).Value, Len(.Range("B" & i).Value) - 6)
　　　　　　　　　FileKey(i - 5, 1) = .Range("C" & i).Value
　　　　　　　 End If
　　　　　Next i
　　　　
　　　　 End With

　　　　 objE.Workbooks(MyFile).Close False
　　　　　
　　　　　 For i = 0 To UBound(FileKey, 1)
　　　　 ' 指定フォルダ内のExcelワークブックのファイル名を参照する(1件目)
　　　　　　　　strFILENAME = Dir("C\10_マスター\" & FileKey(i, 0) & "\" & FileKey(i, 1) & "\" & FileKey(i, 0) & "_" & FileKey(i, 1) & ".xls", vbNormal)　　　　　　 ' 2.
　　　　　　　　If strFILENAME = "" Then
　　　　　　　　　　 MsgBox FileKey(i, 0) & "\" & FileKey(i, 1) & Chr(10) & Chr(13) & _
　　　　　　　　　　 "このフォルダにはExcelワークブックは存在しません。"

　　　　　　　　Else

　　　　　　　　　　 DoCmd.TransferSpreadsheet acImport, 8, FileKey(i, 0) & "_" & FileKey(i, 1), "C:\マスター\" & FileKey(i, 0) & "\" & FileKey(i, 1) & "\" & strFILENAME, True, "SH1!A:BN"
　　　　　　　　End If
　　　　　Next i
　　　　
　　　　Else
　　　　　　MsgBox "該当するファイルが見つかりませんでした", vbOKOnly
　　　　End If
　　End With

よろしくお願いします

469 hits

▼

【11901】アクセスからエクセルファイルを扱う方法 かな 11/1/6(木) 16:38