• 締切済み

VBA 応用の質問です。

Public Sub AAA()   Dim cnn as New ADODB.connection   Dim RS as New ADODB Recoreset   Dim value As Boolean   cnn.connection String = _   "Provaider = micosoft.Jet.DLEDB.4.0;" & _   "Data Source = D:\データ.mdb:" '**************ダイアログボックス表示   value = Application.Dialogs(xlDialogSaveAs).Show   If value = False Then     Exit Sub   End If **************   cnn.Open   Set RS = New ADODB.Recordset   RS.Open Source := "テーブルデータ",ActiveConnection:=cnn,_   Corsor Type := adOpenstatic, Option := adCmdTable   ThisWorkbook.Sheets(1).range("A1").CopyFromRecordset RS   RS.Close   Set.Close   cnn.Close   Set cnn = Nothing End Sub 質問なのですが、上記を実行するとダイアログボックスが表示されます。 新規でファイルを作成して今現在動かしているエクセルブックの名前を変更して保存しているだけになってしまいます。 結局元のブック(マクロ)をコピーしているのと同じです。 私のやりたいことはダイアログボックスを表示させて、新規でブックを作成してデータベースのデータ.mdbのテーブルデータだけを新規ブックシートに書き込みたいです。VBAのマクロの処理などは新規のBookには反映させたくないです。 どうすればいいでしょか? 今日一日使って調べましたが全くできませんでした。

みんなの回答

  • onlyrom
  • ベストアンサー率59% (228/384)
回答No.4

またまた登場、onlyromです。 >>名前を付けて保存のダイアログ上で右クリックしてほんとうに新規ブックが作成できるのか?   ⇒できます ダイアログ上で右クリックですよ? ダイアログの【上】ですよ? 【上】。 ふつう右クリックでブック作成などできるのは デスクトップ上、とか開いてフォルダーの中ですよね。 ま、それは質問者がそうだというのだから置いといて。 >今日一日かけてこんな感じでできました、いかがでしょうか? Good Job!だと思います。 ただ、データも転記しない前から「保存」ダイアログが出るとユーザーは、おい、おい、となりませんか? やはりデータを転記したあと「保存」ダイアログを出すのが使い易いと思いますが。 何れにしろ、質問者は根性、粘りがある人だな、感じました。 その調子で頑張ってください。 以上。

tuka1982
質問者

お礼

返事が大変遅れてしまい申し訳ありませんでした。 ありがとうございました。 1つ質問なのですが、今まではDB→Excelでしたが、 今度は逆にExcel→DBといった処理はあるのでしょうか? 時間がなく少ししか調べられていないのですが、参考サイトなどはありましtら大変お手数ではございますが、教えて頂けないないでしょうか? データベースを更新する処理はありましたが複雑すぎて理解ができておりません。

  • onlyrom
  • ベストアンサー率59% (228/384)
回答No.3

再度の登場、onlyromです。 いくつか疑問点があるのですが、それは置いといて。 新規ブックに名前を付けて保存したければ、データを転記したあと、 「名前を付けて保存」ダイアログを出せばいいのでは? で、転記後にダイアログを出すコード。 '-------------------------------------------- ・・・・これより上は省略・・・・  Dim NewBook As Workbook  Set NewBook = Workbooks.Add  NewBook.Sheets(1).Range("A1").CopyFromRecordset Rs   'ダイアログボックス表示   value = Application.Dialogs(xlDialogSaveAs).Show   If value = False Then     MsgBox "保存はしません"   End If '*新規ブックのクローズ   NewBook.close false End Sub '-----------------------------------------------------   これも違うというのであれば、以下の点を補足要求。 >ダイアログボックスが表示され右クリックでbookの新規作成をします (1)名前を付けて保存のダイアログ上で右クリックしてほんとうに新規ブックが作成できるのか? (2)名前を付けて保存というのは、あくまでも「保存」のためのものであるが、 質問者コードでは、新規ブックを作成するコードもないし、 新規ブックに転記もしないうちに、このダイアログを表示しているのはなぜか? これは(1)と関連あり。 (3)名前を付けて保存ダイアログを表示して保存するということは、 新規ブックの名前は、ユーザーが手入力するということ?   以上。  

tuka1982
質問者

補足

返事が遅れました。 (1)名前を付けて保存のダイアログ上で右クリックしてほんとうに新規ブックが作成できるのか?  ⇒できます。 (3)名前を付けて保存ダイアログを表示して保存するということは、 新規ブックの名前は、ユーザーが手入力するということ?  ⇒ そのとおりです。 (2)はわかりませんが。今日一日かけてこんな感じでできました、いかがでしょうか? Public Sub AAA()   Dim cnn as New ADODB.connection   Dim RS as New ADODB Recoreset   Dim value As Boolean   WorkBooks.Add   cnn.connection String = _   "Provaider = micosoft.Jet.DLEDB.4.0;" & _   "Data Source = D:\データ.mdb:" '**************ダイアログボックス表示   value = Application.Dialogs(xlDialogSaveAs).Show("D:\フォルダ\")   If value = False Then     ActiveWorkbook.Close     Exit Sub   End If **************   cnn.Open      ActiveWorkbook.Sheets(1).Range("A1").CopyFromRecordset RS   ActiveWorkBook.Save   RS.Close   Set.RS = nothing   cnn.Close   Set cnn = Nothing End Sub これでうまくできました。

  • onlyrom
  • ベストアンサー率59% (228/384)
回答No.2

要はマクロのあるブックから、新しいブックを作成し、 その新しいブックにテーブルデータを取込みたい、 ということですね? で、あれば以下のような方法もあります。   >'**************ダイアログボックス表示 >  value = Application.Dialogs(xlDialogSaveAs).Show >  If value = False Then >    Exit Sub >  End If >'************** 上記ダイアログ表示のコードは削除して、 >ThisWorkbook.Sheets(1).range("A1").CopyFromRecordset RS の代わりに以下の3行を追加 Dim NewBook As Workbook Set NewBook = Workbooks.Add NewBook.Sheets(1).Range("A1").CopyFromRecordset Rs   以上。  

tuka1982
質問者

お礼

ありがとうございます。しかしこの方法だとダイアログボックスから作成した ファイル名は全く関係ないものです、あくまでもダイアログボックスから作成 したファイル名に最終的に保存する方法はないでしょうか? onlyromさんに教えていただきました方法から何とか発展させていろいろ試してみましたができませんでした。

回答No.1

何を以て「応用」と言っているのか分かりません。もしかして宿題とか研修課題とかですか? ブックを新規作成する方法 そのブックを Workbook 型のオブジェクト変数で参照する方法 Workbook 型のオブジェクト変数で参照している新規ブックのワークシートにレコードセットの中身を書き出す方法 Workbook 型のオブジェクト変数で参照している新規ブックを保存する方法 これらについて考えてみてください。

tuka1982
質問者

補足

少し説明が足りなかったです。**で囲ってあるダイアログボックスの表示機能をコメントアウトにすると現在アクティブになっているBookシートにデータが書き出されます。 **の中身を使用できる状態にして、ダイアログボックスが表示され右クリックでbookの新規作成をします。新規作成されたBookをダイアログボックスから選択すると元からあるBookの名前が変更されるだけでマクロの機能なども引き継がれてしまいます。 目的はあくまでもダイアログで新規作成をしてデータベースのテーブルだけを反映させたいです。マクロ機能はいりません。

関連する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 /------------------------------------------------/

  • Access ADOについて質問です。

    Access ADOについて質問です。 以下コードでレコードセットを返す関数を使用しています。 動作的には問題ないのですが、標準モジュール内のレコードセットをClose及びNothingしていないのが気になります。 Private Sub Form_Open(Cancel As Integer) Dim rs2 As ADODB.Recordset Set rs2 = New ADODB.Recordset Set rs2 = CreateRecordSet("SELECT * FROM T_Standard;") Set Me.Recordset = rs2 rs2.Close: Set rs2 = Nothing end sub '標準モジュール Public Function CreateRecordSet(strSQL As String) As ADODB.Recordset Dim cn As ADODB.Connection Dim rs As ADODB.Recordset Set cn = New ADODB.Connection cn.ConnectionString = "provider=Microsoft.Jet.OLEDB.4.0;" _ & "Data Source=O:\標準DB\StandardBackEnd.mdb" cn.Open Set rs = New ADODB.Recordset rs.Open strSQL, cn, adOpenStatic, adLockReadOnly Set CreateRecordSet = rs ' rs.Close: Set rs = Nothing   ←この部分 ' cn.Close: Set cn = Nothing   ←この部分 End Function 標準モジュール内ではCloseやNothingしなくてもメモリの開放は行われているのでしょうか? アドバイスよろしくお願いいたします。

  • アクセス VBAのエラー

    以下のコードをwindowsXPで問題なく使っていましたが、windows7で使ったところ 「保存できません」というエラーメッセージが出ます。ただ全く同じコードを(だと思うのですが)リストボックスのダブルクリックで実行すると作動します。参考に二つのコードを書いておきます。 何か原因に心当たりのある方よろしくお願いします。 (コマンドボタン) Private Sub コマンド選択_Click() Dim namecode As String namecode = リスト会員 Dim cn As New ADODB.Connection Dim rs As New ADODB.Recordset Set cn = CurrentProject.Connection rs.Open "MT_会員", cn, adOpenKeyset, adLockOptimistic rs.Find "会員IDkai = " & namecode rs!Selectedkai = True '-1 rs.Save Me!リスト会員.Requery リスト印刷会員.Requery rs.Close: Set rs = Nothing cn.Close: Set cn = Nothing End Sub (ダブルクリック) Private Sub リスト会員_DblClick(Cancel As Integer) Dim namecode As String namecode = リスト会員 Dim cn As New ADODB.Connection Dim rs As New ADODB.Recordset Set cn = CurrentProject.Connection rs.Open "MT_会員", cn, adOpenKeyset, adLockOptimistic rs.Find "会員IDkai = " & namecode rs!Selectedkai = True '-1 rs.Save Me!リスト会員.Requery リスト印刷会員.Requery rs.Close: Set rs = Nothing cn.Close: Set cn = Nothing End Sub

  • 【VBA】アタッチとデタッチについての認識

    VBAを勉強中の者です。カテ違いならすいません。 ******************************************************* Sub test1() Dim cn As ADODB.Connection Dim rs As ADODB.Recordset Set cn = New ADODB.Connection Set rs = New ADODB.Recordset cn.Open "Provider=SQLOLEDB;Data Source=localhost\SQLEXPRESS; " & _ "Initial Catalog=" & データベース名 & ";" & _ "Integrated Security=SSPI" rs.Open "テーブル1", cn, adOpenStatic, adLockOptimistic MsgBox rs.RecordCount rs.Close: Set rs = Nothing cn.Close: Set cn = Nothing End Sub ******************************************************* このコードで アタッチは「Set cn = New ADODB.Connection」、 デタッチは「cn.Close: Set cn = Nothing」 になりますか? ご教授よろしくお願い致します。

  • 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

  • 二つのMDBファイルの間のデータのやり取り

    おせわになります。みなさんの知恵を貸してください。 いかがシステム構成です。 A.mdb(テーブル:Work1) B.mdb(テーブル:Work2) A.mdbはカレントデータベースです。B.mdbはDSN=KANRIで アクセスしたいです。 現在Work1のデータをWork2に追加したいのですが、どのような方法が考えられますか? ちなみに以下のコードを書いてみました。 -------------------------------------------------- Dim cn1 As New ADODB.Connection, cn2 As New ADODB.Connection Dim rs1 As New ADODB.Recordset, rs2 As New ADODB.Connection Dim com As New ADODB.Command, mysql As String Set cn1 = CurrentProject.Connection cn2.ConnectionString = "provider=MSDASQL;DSN=KANRI" mysql = "insert into Work2 select * from Work1" com.activeconnection = cn2 com.commandtext = mysql com.Execute Set com = Nothing rs1.Close: Set rs1 = Nothing rs2.Close: Set rs2 = Nothing cn1.Close: Set cn1 = Nothing cn2.Close: Set ch2 = Nothing -------------------------------------------------- Work1は見当たらないとエラーが出ました。 どなたか教えてください。 rs1.EoF Loop をまわしながら一行ずつ追加するしかないでしょうか?

  • ADO 「Set」は使ったほうがいいのでしょうか?

    Sub test1() Dim cn As ADODB.Connection Dim rs As ADODB.Recordset Set cn = New ADODB.Connection Set rs = New ADODB.Recordse End Sub Sub test2() Dim cn As New ADODB.Connection Dim rs As New ADODB.Recordset End Sub この二つは同じ意味ですか? 「Set」は使ったほうがいいのでしょうか? よろしくお願いします。

  • Accessでのデータベースの使用(VBA)

    Private Sub 実行_Click() Dim cn As ADODB.Connection Dim rs As ADODB.Recordset Dim StSQL As String Set cn = CurrentProject.Connection Set rs = New ADODB.Recordset strSQL = "INSERT INTO マスタ(コード) VALUES(コード) ;" rs.Open strSQL, cn, , adLockOptimistic '//前のコード(エラーになりました。) ' rs.Close 'cn.Close 'Set rs = Nothing 'Set cn = Nothing Set rs = Nothing: Close Set cn = Nothing: Close Accessを使用したvbaのコードの書き方について教えてほしいです。毎度Access の質問ばかりしてすみません。以下のコードはADOを使用してマスタというテーブルを読み込んで最後にrs.CloseでRecordSetを開放しようとしたのですが「オブジェクトが閉じている場合は、操作は許可されません。」というエラーメッセージが出てしまい原因がわかりませんでした。Openしていて開いているはずなのにエラーが出てしまい、 Set rs = Nothing: Closeに変えたら治りました。何故rs.Closeではエラーが出てしまったのでしょうか。 もう一つお聞きしたいです。 strSQL = "INSERT INTO マスタ(コード) VALUES(コード) ;"でコードという名前を付けたテキストボックスの値をマスタテーブルのコードの列に追加したいのですがテキストボックスの値の取り方が分かりません。(コード.Value)とやってみてもだめでした。どうやったらSQL文でテキストボックスの値をテーブルに追加できるんでしょうか。

  • 数値のMAXの値を取得したい ADO VBA

    アクセスです。 ADOで該当のフィールドの数値のMAXの値を取得するにはどうすればいいですか? テーブルの番号フィールドには、 1 2 3 4 5 と入っているのですが、 この場合、一番大きい値は5なので MAX関数のようなもので5を返したいのですが ADOにそのようなプロパティはありますか? オブジェクトブラウザーでRecordsetを見てみましたが 見つけられませんでした。 Sub Sample() Dim cn As New ADODB.Connection Dim rs As New ADODB.Recordset Set cn = CurrentProject.Connection rs.CursorLocation = adUseClient rs.Open "SELECT * FROM T_test", cn, adOpenStatic, adLockPessimistic rs.Sort = "番号 DESC" Debug.Print rs("番号").Value rs.Close: Set rs = Nothing cn.Close: Set cn = Nothing End Sub これで同じような動きは出来ますが、 もっとシンプルにできませんか?

  • VBA ADOのフィルタのアポストロフィーの意味は

    VBAで文字列はダブルコーテーション「”」で括りますが ------------------------------------------------ Sub ADO_Filter() Dim cn As ADODB.Connection Dim rs As ADODB.Recordset Set cn = CurrentProject.Connection Set rs = New ADODB.Recordset rs.Open "T社員名簿", cn, adOpenKeyset, adLockOptimistic rs.Filter = "質問タイトル LIKE '*田*'" rs.Close: Set rs = Nothing cn.Close: Set cn = Nothing End Sub ------------------------------------------------ 上記の '*田*' のアポストロフィーはどういう時に必要なのでしょうか? LIKE演算子を使ってるからか Filterだからか など理由があれば教えて下さい。 また、「'」を使っているのに、以後がコメントにならないのも不思議です。 よろしくお願い致します。