dポイントプレゼントキャンペーン実施中!

いつもいつもお世話になっております(><)
今までこちらで色々質問しながら、
「条件入力フォームで入力した条件で、レコードを条件抽出し、この抽出結果をフォームに出力、かつ、伝票発行する」
というシステムを作っています。

今、伝票発行の部分で、下記のようなプロシージャを組みました。
そして、下記★(コード内参照)の2点で詰まっています。

★1 指定しているクエリは抽出結果のフォームなのですが、これが「SQLステートメントが正しくありません」となります。どうしてでしょうか。ちなみに実在する別のクエリ名にすると、一応動きます。

★2 フォーム上に抽出されたレコードがEOFになるまで、というループ条件にしたいのですが、この部分の記述は正しいでしょうか。

いつも初心者的質問で恐縮です。
どうぞよろしくお願い致します。
---------------------------------------------
Option Compare Database

Private Sub 伝票発行_Click()

Dim db As ADODB.Connection
Dim rs As ADODB.Recordset
Dim app As Object
Dim wb As Excel.Workbook
Dim iRow As Long
Dim iColm As Long

'■初期化
iRow = 12
iColm = 1


'■確認
If MsgBox("伝票を出力します。", vbOKCancel) = vbOK Then

'■DBコネクション
Set db = CurrentProject.Connection
'■レコードセットの取得
Set rs = New ADODB.Recordset
rs.Open "受注集計クエリ_f", db, adOpenStatic, adLockReadOnly '★1
'■Excelアプリの起動及びファイルオープン
Set app = CreateObject("Excel.Application")
app.Workbooks.Open filename:=CurrentProject.Path & "\nouhinsyo.xls"

'■Excelシート名指定
app.Worksheets(1).Select

Do Until rs.EOF '★2
ws.Cells(iRow, iColm + 2) = rs("品番")
ws.Cells(iRow, iColm + 3) = rs("商品名")
ws.Cells(iRow, iColm + 4) = rs("受注数の合計")
ws.Cells(iRow, iColm + 8) = rs("備考")
rs.MoveNext
iRow = iRow + 1
Loop
MsgBox "発行完了。"

End If

rs.Close
app.Quit 'エクセルセッションをクローズする。

Set ws = Nothing '変数の初期化
Set wb = Nothing '変数の初期化
Set app = Nothing '変数の初期化
Set db = Nothing

End Sub

A 回答 (2件)

#1です



> 指定しているクエリは抽出結果のフォームなのですが

既に抽出結果をフォームに表示しており、それをExcel出力したいということでしたか?。

抽出結果を表示しているフォーム名を「F1」と仮定します。


Private Sub 伝票発行_Click()
  Dim app As Object
  Dim iRow As Long
  Dim iColm As Long

  iRow = 12
  iColm = 1

  Set app = CreateObject("Excel.Application")
  app.Workbooks.Open filename:=CurrentProject.Path & "\nouhinsyo.xls"
  app.Worksheets(1).Select

  With Forms("F1").RecordsetClone ' ★
    .MoveFirst
    While (Not .EOF)
      app.Cells(iRow, iColm + 2) = !品番
      app.Cells(iRow, iColm + 3) = !商品名
      app.Cells(iRow, iColm + 4) = !受注数の合計
      app.Cells(iRow, iColm + 8) = !備考
      .MoveNext
      iRow = iRow + 1
    Wend
  End With
  app.Visible = True ' ☆
  Set app = Nothing
End Sub


※ ☆では、Excel書き込み保存していません。(結果を表示する状態)
  書き込み保存用に変更してください。

※ ★では、自分のフォームに抽出結果が表示されているのなら
  With Me.RecordsetClone
  に書き換えてください。

※※ 0件の時に実行するかは処理を盛り込んでください。
  .MoveFirst でエラー?
    • good
    • 0

> ★1 指定しているクエリは抽出結果のフォームなのですが、これが「SQLステートメントが正しくありません」となります。

どうしてでしょうか。ちなみに実在する別のクエリ名にすると、一応動きます。
> ■レコードセットの取得
> Set rs = New ADODB.Recordset
> rs.Open "受注集計クエリ_f", db, adOpenStatic, adLockReadOnly '★1

言われていることが今一つわからないのですが、
"受注集計クエリ_f"は、実在するクエリではないのですか?
ここの部分は、クエリ名またはテーブル名の指定になっています。

私のやり方は、テーブル名/クエリ名を直に指定しない時には、

rs.Source = "SELECT * FROM テーブル名 ORDER BY XXXX;"
rs.Open , db, adOpenStatic, adLockReadOnly

の様にしていますが、書き方はいろいろです。
rs.Open "SELECT * FROM テーブル名 ORDER BY XXXX;", db, adOpenStatic, adLockReadOnly
でもできるようです。


> Do Until rs.EOF '★2
> ws.Cells(iRow, iColm + 2) = rs("品番")

ここの ws は何を設定しているのでしょうか。
(後の方に wb もあるようですが)

ws.Cells(iRow, iColm + 2) = rs("品番")

app.Cells(iRow, iColm + 2) = rs("品番")
で、できると思います。

アプリケーション直で Cells 参照すると(app.Cells(・・・・ )
アクティブワークブック、アクティブワークシートが対象になったと思います。

この回答への補足

>30246kikuさま
いつもありがとうございます。
>"受注集計クエリ_f"は、実在するクエリではないのですか?

実在するクエリです。
実在するにもかかわらず、この部分で上記のエラーが出るうえ、他の実在するクエリを当てはめてみると正常に動くので、どうしてだろうかと思っての質問でした。
こちらが動かないので、それ以外の部分までデバックが至らない現状です。。

>app.Cells(iRow, iColm + 2) = rs("品番")
>で、できると思います。

こちらは、完全にミスでした。シート指定の定義文が抜けていました。

補足日時:2009/11/18 10:03
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

関連するカテゴリからQ&Aを探す