ACCESSのデータをExcelへ取り込むときに起こる現象

ACCESS2010とExcel2010を利用していいます。



エリア: IIf([エリア_分類] Like "*" & "東" & "*","東日本",IIf([エリア_分類] Like "*" & "西" & "*","シェアド西日本","関東"))

とクエリで表示したものをExcelに取り込むと、全部、関東になります。

Sub テーブル取り込み()
Dim con As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim conStr As String

conStr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=絶対パス"
con.Open ConnectionString:=conStr
rs.Open Source:="[Q_本日のクエリ]", ActiveConnection:=con, _
CursorType:=adOpenKeyset, LockType:=adLockOptimistic

Range("A1").CopyFromRecordset Data:=rs
rs.Close
con.Close
End Sub

で取り込んでいます。

何度、作り直しても　同じ結果なんですが、どこが問題なのでしょうか？
ご教示していただけますか？

No.1 ベストアンサー 回答者： xMAKISHIx 回答日時： 2015/11/20 11:12

普段ADO使わないのでDAOになってしまいますが....

Private objDB　As DAO.Database
Private objExcel　As Object
Private objWorkBook　As Object

Sub sample()
　　Dim objRS　As DAO.Recordset
　　Dim strSQL　As String
　　Dim lngRow　As Long
　　Dim lngCol　As Long

　　Set objDB = CurrentDb

　　Set objExcel = CreateObject("Excel.Application")
　　objExcel.Visible = True
　　Set objWorkBook = objExcel.Workbooks.Add

　　strSQL = "SELECT IIf([エリア_分類] Like '*東*','東日本',IIf([エリア_分類] Like '*西*','シェアド西日本','関東')) AS エリア FROM T_Sample"

　　Set objRS = objDB.OpenRecordset(strSQL)

　　For lngCol = 1 To objRS.Fields.Count
　　　　objWorkBook.Activesheet.Cells(1, lngCol).Value = objRS.Fields(lngCol - 1).Name
　　Next

　　lngRow = 2
　　Do Until objRS.EOF
　　　　objWorkBook.Activesheet.Cells(lngRow, 1).Value = objRS!エリア
　　　　lngRow = lngRow + 1
　　　　objRS.MoveNext
　　Loop

　　Set objRS = Nothing
　　Set objDB = Nothing
End Sub

この回答へのお礼

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

このコードを参考にさせていただきました

お礼日時：2015/11/20 13:17