- ベストアンサー
ACCESSからEXCELに出力する際、時間がかかる。
よろしくお願いします。 ACCESS VBA を使用して、既存のEXCELファイルにデータを出力しているのですが、すごく時間がかかってしまいます。件数が少ない時はそれほど気にならないのですが。時間短縮する方法を教えてください。 Sub S_ExportExcel_ADO() Dim CN As ADODB.Connection Dim rst As ADODB.Recordset Dim objExcel As Excel.Application Dim i As Integer Dim W_SQL As String On Error GoTo Err_S_ExportExcel_ADO Set objExcel = New Excel.Application objExcel.Workbooks.Open ("test.xls") objExcel.Worksheets("sheet1").Select Set CN = CurrentProject.Connection Set rst = New ADODB.Recordset W_SQL = "SELECT * FROM データ" rst.Open W_SQL, CN, adOpenKeyset, adLockReadOnly i = 1 Do Until rst.EOF objExcel.Cells(i, 4) = Trim("" & rst![データ１]) objExcel.Cells(i, 5) = Trim("" & rst![データ２]) objExcel.Cells(i, 6) = Trim("" & rst![データ３]) objExcel.Cells(i, 7) = Trim("" & rst![データ４]) objExcel.Cells(i, 9) = Trim("" & rst![データ５]) '＊＊＊省略＊＊＊ objExcel.Cells(i, 35) = Trim("" & rst![データ１５]) objExcel.Cells(i, 36) = Trim("" & rst![データ１６]) i = i + 1 rst.MoveNext Loop 'EXCEL保存 objExcel.ActiveWorkbook.Close objExcel.Quit rst.Close CN.Close Set rst = Nothing Set CN = Nothing Set objExcel = Nothing End Sub
- deny
- お礼率64% (11/17)
- その他（プログラミング・開発）
- 回答数2
- ありがとう数3
- みんなの回答 （2）
- 専門家の回答
質問者が選んだベストアンサー
履歴です。 #1のtodo36さんの発言 http://okweb.jp/kotaeru.php3?q=475151
その他の回答 (1)
- osamuy
- ベストアンサー率42% (1231/2878)
Accessのマクロでワークシート変換（Excel形式でのエクスポート）を行うか、Excelの外部データの取り込み＞データベースクエリで、Excelファイルにデータをとりこんでみては。 ビルトイン機能なので、VBAよりは処理速度が速いので。
お礼
回答ありがとうございます。追加質問で申し訳ないのですが、既存のシートにデータを置きたいのですが、できるのでしょうか？
関連するQ&A
- ACCESS VBA
ACCESSで検索フォームを作りたいと思っています。 VBAを使って行きたいと思うのですが、うまくいきません。 希望としては、該当するレコードのデータを抽出したいです。 よろしくお願いいたします。 ※現段階でのソースを書いてみました。 最終的に行いたい処理とは違うのですが、根本的に間違っているようなので簡略化しました。 /------------------------------------------------/ Private Sub コマンド1_Click() Dim cn As ADODB.Connection Dim rs As ADODB.Recordset Dim sql As String '接続 Set cn = CurrentProject.Connection 'レコードセットを取得 Set rs = New ADODB.Recordset sql = "SELECT * FROM 従業員データ " & _ "WHERE 年齢=30" rs.Open sql, cn, adOpenDynamic, adLockReadOnly rs.Close: Set rs = Nothing cn.Close: Set cn = Nothing End Sub /------------------------------------------------/
- ベストアンサー
- Visual Basic
- ACCESSでExcelにデータ出力、高速化
ACCESSのVBAを使ってテーブルのデータを 既存ブックに出力し、別名で保存をしたいのですが、 どうも、処理が遅くて困っています。 改善点がありましたら教えてくださいお願いいたします。 Dim objExcel As Excel.Application Dim xlWrkbk As Excel.Workbook Dim xlWrksh As Excel.Worksheet Dim rs As DAO.Recordset Dim strFilename As String strFilename = CurrentProject.Path & "既存ブック名.XLS" Set objExcel = New Excel.Application Set xlWrkbk = objExcel.Workbooks.Open(Filename:=strFilename, ReadOnly:=True) Set xlWrksh = xlWrkbk.Worksheets("シート名") Set rs = CurrentDb.OpenRecordset("テーブル名", dbOpenSnapshot) With objExcel xlWrksh.Range("A:N").Clear xlWrksh.Range("A2").CopyFromRecordset rs xlWrkbk.SaveAs Filename:=CurrentProject.Path & "新しいブック名.xls" xlWrkbk.Close .Quit rs.Close End With Set rs = Nothing Set objExcel = Nothing Set xlWrkbk = Nothing Set xlWrksh = Nothing
- ベストアンサー
- その他（プログラミング・開発）
- ExcelからAccess2013DBを更新する時
Excel2013 vba-> Access2013 mdbファイル 問題点：以下のソースを実行すると、エラーが発生します。このエラーをなくしてアクセスデータベースのテーブルの情報の更新、新規追加、削除を行いたいです。 エラー内容：実行時エラー'3251' 現在のRecordsetは更新をサポートしていません。プロバイダーか、選択されたロックタイプの限界の可能性があります。 ソース： Sub 登録処理() Dim Rst As adodb.Recordset Dim SQL As String Dim Rg As Range Dim RgData As Range Dim lngLastRow As Long Dim RgDel As Range On Error GoTo errH Set RgData = mySh.Range("B2") lngLastRow = RgData.End(xlDown).Row Set RgData = mySh.Range(RgData, mySh.Range("AB" & lngLastRow)) SQL = "Select * from [会社管理テーブル]" Call DBconection2 Set Rst = New adodb.Recordset With Rst .ActiveConnection = Cn 'SQL文でテーブル名と抽出条件を指定する .Source = SQL .CursorLocation = 3 ' クライアントサイドカーソルに変更 .Open End With Dim y As Long Sheets("会社管理").Select If Rst.EOF = False And Rst.BOF = False Then For i = 1 To RgData.Rows.Count If Cells(i + 1, 1).Value = "変更" Then Rst.MoveFirst Rst.Find "[施工会社ID]=" & RgData(i, 1).Value If Rst.EOF Then Else Rst.Fields("会社ID").Value = RgData(i, 2).Value Rst.Fields("会社名").Value = RgData(i, 3).Value Rst.Fields("フリガナ").Value = RgData(i, 4).Value Rst.Update End If Cells(i + 1, 1).Value = "" ElseIf Range(i, 1).Value = "削除" Then Rst.MoveFirst Rst.Find "[会社ID]=" & RgData.Cells(i, 1).Value If Rst.EOF Then Else Rst.Delete End If Set RgDel = Rows(i + 1 & ":" & i + 1) RgDel.Select RgDel.Delete ElseIf Range(i, 1).Value = "新規" Then Rst.AddNew Rst.Fields("会社ID").Value = RgData(i, 2).Value Rst.Fields("会社名").Value = RgData(i, 3).Value Rst.Fields("フリガナ").Value = RgData(i, 4).Value Rst.Update Cells(i + 1, 1).Value = "" End If Next i End If exitH: Rst.Close: Set Rst = Nothing Call DBclose2 Exit Sub errH: MsgBox Err.Number & "(" & Err.Description & ")" GoTo exitH End Sub Sub DBconection2() Set Cn = New adodb.Connection Cn.Provider = "Microsoft.Jet.OLEDB.4.0" Cn.Open modPublic.DBPATH End Sub Function MakeDBconection() As adodb.Connection Set Cn = New adodb.Connection Cn.Provider = "Microsoft.Jet.OLEDB.4.0" Cn.Open modPublic.DBPATH Set MakeDBconection = Cn End Function Sub DBclose2() Cn.Close Set Cn = Nothing End Sub Sub EraseContents(s_Rg As Range) s_Rg.ClearContents End Sub 誰か、解決方法がおわかりの方がいましたら、アドバイスをよろしくお願いします。
- 締切済み
- その他(データベース)
- VB６．０でエクセルを扱うプログラムについて
こんにちは。VB初級者です。宜しくお願いします。 現在、VB６．０でエクセルの表を操作するようなプログラムを作っています。下に書いたプログラム(わかりにくいとは思いますが、ご教授お願いします。）で値の更新は出来たようなのですが、実際に表を開こうとすると”不正な処理が行われました”というエラーメッセージが出て開くことが出来ません。ADOオブジェクトでエクセルを扱うのがちょっとおかしい(？)のかもしれませんが、今回はEXCELオブジェクトは使わないという方針です。 自分ではどこが間違っているかわかりませんでしたので教えて頂ければと思います。宜しくお願い致します。 Private Sub Command1_Click() Dim cn As ADODB.Connection Set cn = New ADODB.Connection cn.Provider = "Microsoft.Jet.OLEDB.4.0" cn.Properties("Extended Properties") = "Excel 8.0" cn.Properties("Data Source") = "C:\VB\株価管理\株価.xls" cn.Open Dim cmd As ADODB.Command Dim mySQL As String mySQL = "update [株価$] set 高値 =10000 where 高値 = 7" Set cmd = New ADODB.Command cmd.ActiveConnection = cn cmd.CommandText = mySQL cmd.Execute Set rst = New ADODB.Recordset rst.Source = "Select * From [株価$]" rst.ActiveConnection = cn rst.CursorType = adOpenDynamic rst.Open , , , , adCmdText Do While Not rst.EOF Debug.Print rst.Fields("高値") rst.MoveNext Loop rst.Close cn.Close Set rst = Nothing Set cn = Nothing Set cmd = Nothing End Sub
- ベストアンサー
- Visual Basic
- AccessからExcelに罫線付で出力したい
Access2010使用。 AccessのクエリからExcelにエクスポートした際、罫線などの体裁を整えて出力したいと思っています。 データは下記のコードでなんとか出るようになりましたが、このコードの中に罫線を引くコードを 入れる方法がどうしてもわかりません。 検索してあれこれ試しましたが「オブジェクトがない」や「サポートしてない」などエラーメッセージ が出てしまい、ＶＢＡの基礎知識がない私にはどうしてもわかりませんでした。 どうかアドバイスお願いいたします。 （クエリ名は Q_ABC とします） やりたいことは ・データがある行列に格子線を引き、１行目の項目列の下は二重線、外側は太線にしたい。 ・行の高さを数値で指定したい。 です。なお、行数はその都度増えます。 また、できれば 印刷する際の設定で用紙を「Ａ３横」で、常に横１ページに入るように縮小率を設定しておきたい のですが可能でしょうか？ どうぞよろしくお願いします。 Private Sub コマンド0_Click() Set xlapp = CreateObject("Excel.application") Dim xlbook As Excel.Workbook Dim xlsheet As Excel.Worksheet Dim rs As New ADODB.Recordset Dim objEXCEL As Object Dim nYLINE As Integer Dim nXLINE As Integer Dim nRCNT As Integer Dim strWORK As String Set xlApp = CreateObject("Excel.Application") Set objEXCEL = CreateObject("Excel.Application") objEXCEL.Visible = True objEXCEL.Workbooks.Add objEXCEL.sheets.Add re.Open "Q_ABC", CurrentProject.Connection, adOpenKeyset, adLockOptimistic '見出しを書き込む objEXCEL.Range("A1") = "ID" objEXCEL.Range("B1") = "氏名" objEXCEL.Range("C1") = "住所" == 以下T列まで省略 == '項目名をセルの中央に objEXCEL.Range("A1:T1").HoraizontalAlignment = xlHAilignCenterAcrossSelection Dim yLINE As Integer '行カウンター yLINE = 2 'ループ処理 While rs.EOF = False 'accessからデータのセット objEXCEL.Cells(yLINE, "A") = rs.Fields("ID") objEXCEL.Cells(yLINE, "B") = rs.Fields("氏名") objEXCEL.Cells(yLINE, "C") = rs.Fields("住所") == 以下T列まで省略 == rs.MoveNext yLINE = yLINE + 1 Wend 'シートの列幅の自動調整 objEXCEL.Cells.EntireColumn.AutoFit rs.Close Set rs = Nothing End Sub
- ベストアンサー
- オフィス系ソフト
- ADOでエクセルからSQL Serverへデータを移行するには
エクセルｖｂａのＡＤＯを使って、 SQL Serverの「test」という名のデータベースの「Table_1」に 新規レコードを追加する事はできますか？ エクセルからアクセスには Sub test() Dim データベース名 As String Dim cn As ADODB.Connection Dim rs As ADODB.Recordset Set cn = New ADODB.Connection Set rs = New ADODB.Recordset cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & データベース名 rs.Open "Ｔテーブル１", cn, adOpenKeyset, adLockOptimistic rs.AddNew rs.Fields("フィールド１") = データ rs.Update rs.Close cn.Close Set rs = Nothing Set cn = Nothing End Sub で移行しています。 これをエクセルからSQL Serverへ移行させるにはどうすればいいのでしょうか？ よろしくお願いします。
- ベストアンサー
- SQL Server
- excel vba で .mdb のデータ抽出
excel vba で postdata.mdbのpostレコードから条件に合うデータを抽出しようとしています。 数日間、いろいろ調べていますが分かりません。 おそらく、SQLの部分だと思うのですが・・・ adoは初めて使う素人なので教えていただけないでしょうか。 On Error GoTo ErrGyo Set cn = New ADODB.Connection cn.Provider = "Microsoft.Jet.OLEDB.4.0" cn.Open ThisWorkbook.Path & "\postdata.mdb" Dim Rs As ADODB.Recordset Dim SQL As String Dim T_ken As String Dim T_si As String Dim T_mati As String Dim i As Long T_ken = TextBox1.Value ’フォームにテキストボックス T_si = TextBox2.Value T_mati = TextBox3.Value SQL = "SELECT * FROM post WHERE ken like '" & T_ken & "' and si LIKE '" & T_si & "' and mati LIKE '" & T_mati & "'" Set Rs = New ADODB.Recordset Rs.Open SQL, cn, adOpenForwardOnly, adLockReadOnly MsgBox Rs.RecordCount ’ここでチェックすると -1 となる？？？ If Rs.RecordCount = 0 Then MsgBox "該当するレコードは見つかりませんでした。", vbInformation Else For i = 1 To Rs.RecordCount Cells(i, 1) = Rs!num Cells(i, 2) = Rs!ken Cells(i, 3) = Rs!si Cells(i, 4) = Rs!mati Rs.MoveNext Next End If Rs.Close: Set Rs = Nothing cn.Close: Set cn = Nothing Exit Sub ErrGyo: MsgBox "postdataへの接続に失敗しました", vbCritical
- ベストアンサー
- Visual Basic
- Accessで、メモリを開放するタイミング
すみませんが、教えてください。 次のコードように、SQL命令を2回以上行う場合、メモリの開放は、最後だけでよいのでしょうか？ これでも、一応動くのですが、メモリを余計に消費していないのかどうか、よく分かりません。 SUB SAMPLE() Dim CN As ADODB.Connection Dim RS As ADODB.Recordset Dim SQL As String '接続 Set CN = CurrentProject.Connection 'レコードセットを取得(1) Set RS = New ADODB.Recordset SQL = "SELECT COUNT(*) AS CNT FROM 生徒名簿 WHERE クラス = 'TS'" RS.Open SQL, CN, adOpenKeyset, adLockOptimistic Msgbox(CNT) 'レコードセットを取得(2) Set RS = New ADODB.Recordset SQL = "SELECT COUNT(*) AS CNT FROM 生徒名簿 WHERE クラス = 'WS'" RS.Open SQL, CN, adOpenKeyset, adLockOptimistic Msgbox(CNT) '終了 RS.Close: Set RS = Nothing CN.Close: Set CN = Nothing End Sub
- ベストアンサー
- その他(データベース)
- アクセスVBA。ADO
CSVから列を分割してテーブルにしたいかったので 下記のコードを記述しましたが、 Dim cn As ADODB.Connection Dim rs As New ADODB.Recordset Dim datacount As Long Set cn = New ADODB.Connection With cn .ConnectionString = "Provider=Microsoft.jet.OLEDB.4.0;Data Source=" & CurrentProject.Path & "\;" .Properties("Extended Properties").Value = "text;HDR=YES;" .Open End With Set rs = cn.Execute("SELECT * FROM 構成マスタ.csv") datacount = rs.Fields.Count For i = 0 To datacount strsql = "SELECT " & rs.Fields(i).Name & " INTO " & rs.Fields(i).Name & " FROM 構成マスタ.csv;" cn.Execute strsql Next i rs.Close cn.Close Set rs = Nothing Set cn = Nothing SQLを実行するところで、「日付エラー」となってしまいます。 データには特に日付等はないのでエラーになる原因がわかりません。 どなたかご教示いただけますでしょうか。
- 締切済み
- Visual Basic
- AccessからExcelへの出力
質問します。 AccessからExcelへ、VBAで指定セルに指定データを落としこむコーディングをしています。 とあるサイトを参考に、下記のコードを組みましたが、実行すると砂時計のまま動かなくなってしまいます。 何が悪いのでしょうか？ ＳＱＬでしょうか？ 時間がなくて困っています。 何卒よろしくお願いします。（＞＜） Option Compare Database Private Sub output() On Error Resume Next Dim app As Object Set app = CreateObject("Excel.Application") Dim oRs As Recordset Dim strSQL As String Dim Wb As Excel.Workbook Dim Ws As Excel.Worksheet Dim FileName As String Dim Worksheet As String Dim X As Long Dim Y As Long FileName = "C:\nouhinnsyo.xls" 'エクセルのファイル名 Worksheet = "納品書" 'ワークシート名 Set Wb = app.Workbooks.Open(FileName) 'ワークブックの指定 Set Ws = Wb.Worksheets(1) 'ワークシートの指定 strSQL = "SELECT 日付,伝票番号,品番,商品名,出庫数,摘要" strSQL = strSQL & vbCrLf & "FROM 棚卸マスタ" '出力用レコードセット Set oRs = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset) Y = 12 X = 0 Do Until oRs.EOF Ws.Cells(Y, X + 1) = oRs("日付") Ws.Cells(Y, X + 2) = oRs("品番") Ws.Cells(Y, X + 3) = oRs("商品名") Ws.Cells(Y, X + 4) = oRs("出庫数") Ws.Cells(Y, X + 9) = oRs("摘要") oRs.MoveNext Y = Y + 1 Loop oRs.Close Wb.SaveAs FileName 'ファイルの保存 Wb.Close 'ワークブックのクローズ Ex.Quit 'エクセルセッションをクローズする。 Set Ws = Nothing '変数の初期化 Set Wb = Nothing '変数の初期化 Set Ex = Nothing '変数の初期化 Set oRs = Nothing End Sub
- 締切済み
- その他(データベース)
お礼
お回答ありがとうございます。配列を使って貼り付けることにしました。とても処理が早くなりました。ありがとうございます。