Access VBA質問箱 IV

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

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


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

694 / 9994

←次へ　｜　前へ→


	【12610】Access2013環境だと上手くいかない？

Yakin - 14/9/6(土) 21:56 -


	引用なし

	パスワード

こんばんは、

Access2013の環境で、古いバージョンのVBAが動かなくて、試行錯誤で
やってみましたが、うまくいきません。
助けて下さい！よろしくお願いします。

問題点：Access2013/Excel2013環境で、以下のVBAを実行すると、xlsWkb.SaveAs OutFileのところ黄色反転

--------------------------------------------------------------------------
Function ExcelExport()
'※要参照 Microsoft DAO x.x Object Library
Const TName = "分布_003"　　　　　 'データの入っているテーブル名
Const OutFile = "C:\分析データ.xls"　　 'エクスポート先 Excelファイル名
Dim RS1 As DAO.Recordset
Dim RS2 As DAO.Recordset
Dim strSQL1 As String
Dim strSQL2 As String
Dim xlsApp As Object
Dim xlsWkb As Object
Dim xlsSht As Object
Dim i As Long

Dim RetVal As Variant
　　RetVal = SysCmd(acSysCmdSetStatus, "【分析データ】出力中・・・しばらくお待ち下さい")
　　On Error Resume Next
　　　　Kill OutFile
　　On Error GoTo 0
　
　　Set xlsApp = CreateObject("Excel.Application")
　　Set xlsWkb = xlsApp.Workbooks.Add
　
　　strSQL2 = "SELECT DISTINCT 分布エリア FROM " & TName
　
　　Set RS2 = CurrentDb.OpenRecordset(strSQL2, dbOpenSnapshot)
　　Do Until RS2.EOF
　　　　Set xlsSht = xlsWkb.Worksheets.Add
　　　　　　xlsSht.Name = RS2![分布エリア]
　　　
　　　　strSQL1 = "SELECT * FROM " & TName _
　　　　　　　 & " WHERE 分布エリア = '" & RS2![分布エリア] & "';"
　　
　　　　Set RS1 = CurrentDb.OpenRecordset(strSQL1, dbOpenSnapshot)
　　　　　　For i = 1 To RS1.Fields.Count
　　　　　　　　xlsSht.Cells(1, i).Value = RS1(i - 1).Name
　　　　　　Next
　　　　　　xlsSht.Range("A2").CopyFromRecordset RS1
　　　　　　xlsSht.Range("A1").CurrentRegion.Columns.AutoFit
　　　　　　xlsSht.Range("A1").CurrentRegion.Rows.AutoFit
　　　　　　RS1.Close
　　　　Set RS1 = Nothing
　　　　RS2.MoveNext
　　Loop
　　
　　Set RS1 = Nothing
　　RS2.Close: Set RS2 = Nothing
　　
　　On Error Resume Next
　　　　For i = 1 To 3
　　　　　　xlsWkb.Sheets("Sheet" & i).Delete
　　　　Next
　　On Error GoTo 0
　　Set xlsSht = Nothing
　　'
　　'↓黄色反転。Access2003/Excel2003の時、問題なかった。
　　xlsWkb.SaveAs OutFile
　　xlsWkb.Close: Set xlsWkb = Nothing
　　xlsApp.Quit: Set xlsApp = Nothing
　
　 MsgBox "終了しました。"
End Function
--------------------------------------------------------------------------

377 hits

▼

【12610】Access2013環境だと上手くいかない？ Yakin 14/9/6(土) 21:56