Excel2010 (x64）ADO 実行時エラー ’-2147467259 外部テーブルのフォーマットが正しくありません

質問

_{2012年12月28日金曜日 14:35}

前回trapemiya（MVP)さんの紹介のURL中のサイト　[White Tigre]　　

ADOを使ってExcelシートを読み出す方法を少しアレンジした下記のプログラムでエラーが出てしまいます。

Option Explicit
    Dim cn         As ADODB.Connection
    Dim rs         As ADODB.Recordset
    Dim ①strFilePath As String
    Dim ②strFileName As String
'White_Tiger

Sub loadADOJetOLEDB()
   On Error GoTo Err_Handler
    ①strFilePath = "c:￥Users\   '--ファイルパスを指定する
    ②strFileName = "Book1.xlsm"     ' --ファイル名を指定する"
    ②strFileName = ①strFilePath & ②strFileName '  --面倒なのでファイルパス＋ファイル名にする
   
    　Application.ScreenUpdating = False
      ActiveSheet.Protect UserInterfaceOnly:=True '--マクロによる操作の保護を解除
      ActiveSheet.Unprotect

         Set cn = New ADODB.Connection
         Set rs = New ADODB.Recordset
        
'①⇒　 cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & ②strFileName & ";" & "Extended Properties=_

　　　　　""Excel 8.0;HDR=yes;"";"  '--ワークシートにヘッダー行が無い時は、HDR には No を設定します。結構重要なポイントです。
           
            rs.Open "SELECT * FROM [S_Name$AA11:BB50]", cn, adOpenStatic, adLockOptimistic, adCmdText '--読み込みシート名＄
           
            ThisWorkbook.Sheets("Sheet1").Range("AA11").CopyFromRecordset rs  '--'書き込みシート「Sheet1」のB2に貼り付けます。
           
            rs.Close: Set rs = Nothing    '--オブジェクトの破棄
            cn.Close: Set cn = Nothing  　'--オブジェクトの破棄
    'Application.ScreenUpdating = True
    Exit Sub
   
Err_Handler:
    Application.ScreenUpdating = True
    MsgBox CStr(Err.Number) & Err.Description
End Sub

'①⇒ここで　実行時エラー '-2147467259（80004005）
  　　 外部テーブルのフォーマットが正しくありませんと出ます
　　どうすればエラーが出なくなるかわかりません、お手上げです。

すべての返信 (2)

_{2012年12月31日月曜日 15:13 ✅回答済み}

参考までに

Excel2010（64）拡張子.Xlsm　が使える様になりました。
下記のプログラムで点線で囲ってある部分の上が変更してところです。下は前回のプログラムです。

Option Explicit
    Dim cn          As ADODB.Connection
    Dim rs          As ADODB.Recordset
    Dim strFilePath As String
    Dim strFileName As String
   
Sub loadADOJetOLEDB()
    'On Error GoTo Err_Handler
    Sheets("Sheet1").Range("A1:AY65536").ClearContents  ' Sheet1のデータをクリアする
    strFilePath = "c:\Users\David\Documents\  ' ファイルパスを指定する
    strFileName = "Book2_17.xlsm"  ' ファイル名を指定する
    strFileName = strFilePath & strFileName  ' 面倒なのでファイルパス＋ファイル名にする
   
    Application.ScreenUpdating = False
    Set cn = New ADODB.Connection
    Set rs = New ADODB.Recordset
   
 ’  
  cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                  "Data Source=" & strFileName & ";" & _
                  "Extended Properties=""Excel 12.0;HDR=Yes;IMEX=1;Readonly=False"""
                 
 ’  
  'cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
         "Data Source=" & strFileName & ";" & _
        "Extended Properties=""Excel 8.0;HDR=Yes;"";"
 ’  

    rs.Open "SELECT * FROM [7201$]", cn, _
        adOpenStatic, adLockOptimistic, adCmdText
 
    ThisWorkbook.Sheets("Sheet1").Range("A1").CopyFromRecordset rs   ' シート「Sheet1」のB2に貼り付けます。
       
    rs.Close: Set rs = Nothing   ' オブジェクトの破棄
    cn.Close: Set cn = Nothing  ' オブジェクトの破棄
   
    Application.ScreenUpdating = True
    Exit Sub
   
Err_Handler:
    Application.ScreenUpdating = True
    MsgBox CStr(Err.Number) & Err.Description
End Sub               

---

_{2012年12月30日日曜日 13:26}

 

 　　　　いろいろテストした結果、下記の事が解りましたので報告します。
 　　
 　　     ②strFileName = "Book1.xlsm"     ' --ファイル名を指定する"
 　　     　拡張子がXlsなら開きます。
 　　     ②strFileName = "Book1.xls"に変更しました。
 　　    
 　　    
 　　     rs.Open "SELECT * FROM [S_Name$AA11:BB50]", cn, adOpenStatic, adLockOptimistic, adCmdText '--読み込みシート名＄
 　　     　　　　　　　　　　　 [S_Name$AA11:BB50]　を　[Sheet1$] に変更しました。
 　　     rs.Open "SELECT * FROM [Sheet1$]", cn, adOpenStatic, adLockOptimistic, adCmdText
 　　    
 　　    
 　　     ThisWorkbook.Sheets("Sheet1").Range("AA11").CopyFromRecordset rs  '--'書き込みシート「Sheet1」のB2に貼り付けます。
 　　     　　　         Range("AA11") を Range("A1")に変更しました。
 　　     ThisWorkbook.Sheets("Sheet1").Range("A1").CopyFromRecordset rs 

　上記3ヶ所を変更したらファイルを読み込みました。（早いです）

　 Xlsmの開き方がまだ解りません。
　
　まだまだ問題がたくさん出てくると思います。よろしくお願いします。