Access VBA質問箱 IV

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

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


86 / 500 ページ ←次へ | 前へ→

【11584】Re:フィルタ適用後のEXCEL出力時について
発言  247b  - 10/4/6(火) 16:17 -

引用なし
パスワード
   机上デバッグでは埒があかないので、カラム名を同じにしたテーブルを使用してSQLを作りました。
あまり良い例ではありませんが、動作は確認しています。問題は欲しいデータが取れるかどうかなので、確認してください。

コマンド36_Click のCase2のSQLですが、以下のもので置き換え可能ですか?
問題ない場合、これを使ってプログラム実行してみてください

select TOHO_TABLE.[COMM]
,TOHO_TABLE.[A]
,TOHO_TABLE.[C]
,TOHO_TABLE.[G]
,TOHO_TABLE.[D]
,TOHO_TABLE.[E]
,TOHO_TABLE.[F]
,TOHO_TABLE.[H]
,TOHO_TABLE.[コメント]
,TOHO_TABLE.[I]
,TOHO_TABLE.[J]
,TOHO_TABLE.[K]
from TOHO_TABLE
WHERE
TOHO_TABLE.E In
 (SELECT tmp2.E FROM
  (SELECT COUNT(*),Tmp.E FROM TOHO_TABLE As Tmp 
  GROUP BY Tmp.E HAVING Count(*)>1) AS Tmp2)
AND TOHO_TABLE.E<>''
ORDER BY TOHO_TABLE.E DESC


コマンド41_Click のSQLも上記SQLを使って試した版を記載しておきます。
SELECT
TEST_TABLE.A,
TEST_TABLE.COMM AS テスト,
TEST_TABLE.C AS 名A,
TEST_TABLE.D AS 名B,
TEST_TABLE.E AS アドレス,
TEST_TABLE.F AS 機会番号,
TEST_TABLE.G AS 名C,
TEST_TABLE.H AS 使用者,
TEST_TABLE.コメント,
TEST_TABLE.I,
TEST_TABLE.J,
TEST_TABLE.K
FROM (select TOHO_TABLE.[COMM]
,TOHO_TABLE.[A]
,TOHO_TABLE.[C]
,TOHO_TABLE.[G]
,TOHO_TABLE.[D]
,TOHO_TABLE.[E]
,TOHO_TABLE.[F]
,TOHO_TABLE.[H]
,TOHO_TABLE.[コメント]
,TOHO_TABLE.[I]
,TOHO_TABLE.[J]
,TOHO_TABLE.[K]
from TOHO_TABLE
WHERE
TOHO_TABLE.E IN
 (SELECT tmp2.E FROM
  (SELECT COUNT(*),Tmp.E FROM TOHO_TABLE As Tmp 
  GROUP BY Tmp.E HAVING Count(*)>1) AS Tmp2)
AND TOHO_TABLE.E<>''
ORDER BY TOHO_TABLE.E DESC
) AS TEST_TABLE
WHERE True
ORDER BY TOHO_TABLE.E DESC
・ツリー全体表示

【11583】Re:フィルタ適用後のEXCEL出力時について
質問  VBA初心者  - 10/4/6(火) 14:28 -

引用なし
パスワード
   お忙しい中、有難うございます。

ご教授いただいたものをこちらで実行してみたら、

「このフォームまたはレポートで指定されているレコードソース
'ORDER BY TOHO_TABLE.E DESC 'は存在しません」と出てしまいます。

「'ORDER BY TOHO_TABLE.E DESC '」をコメントで潰して再実行するとその
前のソースコードでエラーになります。

*イミディエイト表示
「ORDER BY TOHO_TABLE.E DESC
 GROUP BY Tmp.[E] HAVING Count(*)>1 )) AND ((TOHO_TABLE.E)<>"")) 」

Me.RecordSource = frmRecSource
  Me.Requery
にてエラーが発生したステートメントとして黄色でマーキングされてしまいます。

---------------------------VBAソース--------------------------------------
Private Sub コマンド36_Click()

Me.RecordSource = frmRecSource
  Me.Requery
 
End Sub


Function frmRecSource() As String
  Dim strSQL As String
 
  Dim strWH As String
  
  Select Case Me.フレーム54
  Case 1
     strSQL = "select * " _
      & "from TOHO_TABLE "
  Case 2
      strSQL = "select TOHO_TABLE.[COMM]"
       strSQL = sqrSQL & ", TOHO_TABLE.[A]"
       strSQL = sqrSQL & ", TOHO_TABLE.[C]"
       strSQL = sqrSQL & ",TOHO_TABLE.[G]"
       strSQL = sqrSQL & ", TOHO_TABLE.[D]"
       strSQL = sqrSQL & ", TOHO_TABLE.[E]"
       strSQL = sqrSQL & ", TOHO_TABLE.[F]"
       strSQL = sqrSQL & ",TOHO_TABLE.[H]"
       strSQL = sqrSQL & ", TOHO_TABLE.[コメント] "
'追加開始
       strSQL = sqrSQL & ",TOHO_TABLE.[I]"
       strSQL = sqrSQL & ",TOHO_TABLE.[J]"
       strSQL = sqrSQL & ",TOHO_TABLE.[K]"
'追加終了
       strSQL = sqrSQL & " from TOHO_TABLE"
       strSQL = sqrSQL & " WHERE (((TOHO_TABLE.E) In (SELECT Tmp.[E] FROM [TOHO_TABLE] As Tmp "
       strSQL = sqrSQL & " GROUP BY Tmp.[E] HAVING Count(*)>1 )) AND ((TOHO_TABLE.E)<>"""")) "
       strSQL = sqrSQL & " ORDER BY TOHO_TABLE.E DESC "

End Select
  
  Debug.Print strSQL
  frmRecSource = strSQL
  
End Function

という記述にしております。
どうかお忙しいと思いますが、ご教授をお願い致します。

▼247b さん:
>生成されたSQLを拝見すると、I,J,Kの3項目が、入れ子のSQL(コマンド36_Clickで生成しているSQL)に不足しています。また、エイリアスも不足しているので、一応、書き換え例を以下に記載します。
>こちらでは、プログラム実行していない(というかできない)ので、細かなミスがあるかもしれませんが、その点はご勘弁ねがいます。
>WHERE句はTrueになっているため、特に条件は存在しないようですので、問題ありません。
>
>1.
>Private Sub コマンド36_Click()
>Case 2
>     strSQL = "select TOHO_TABLE.[COMM]"
>       strSQL = sqrSQL & ", TOHO_TABLE.[A]"
>       strSQL = sqrSQL & ", TOHO_TABLE.[C]"
>       strSQL = sqrSQL & ",TOHO_TABLE.[G]"
>       strSQL = sqrSQL & ", TOHO_TABLE.[D]"
>       strSQL = sqrSQL & ", TOHO_TABLE.[E]"
>       strSQL = sqrSQL & ", TOHO_TABLE.[F]"
>       strSQL = sqrSQL & ",TOHO_TABLE.[H]"
>       strSQL = sqrSQL & ", TOHO_TABLE.[コメント] "
>'追加開始
>       strSQL = sqrSQL & ",TOHO_TABLE.[I]"
>       strSQL = sqrSQL & ",TOHO_TABLE.[J]"
>       strSQL = sqrSQL & ",TOHO_TABLE.[K]"
>'追加終了
>       strSQL = sqrSQL & " from TOHO_TABLE"
>       strSQL = sqrSQL & " WHERE (((TOHO_TABLE.E) In (SELECT Tmp.[E] FROM [TOHO_TABLE] As Tmp "
>       strSQL = sqrSQL & " GROUP BY Tmp.[E] HAVING Count(*)>1 )) AND ((TOHO_TABLE.E)<>"""")) "
>       strSQL = sqrSQL & " ORDER BY TOHO_TABLE.E DESC "
>
>
>2.
>Private Sub コマンド41_Click()
>
>strSQL = ""
>  strSQL = strSQL & " SELECT TBL.A "
>  strSQL = strSQL & " , TBL.COMM AS B "
>  strSQL = strSQL & " , TBL.C AS 物品名 "
>  strSQL = strSQL & " , TBL.D AS 名1 "
>  strSQL = strSQL & " , TBL.E AS アドレス "
>  strSQL = strSQL & " , TBL.F AS 機会 "
>  strSQL = strSQL & " , TBL.G As 名3 "
>  strSQL = strSQL & " , TBL.H As 使用者 "
>  strSQL = strSQL & " , TBL.コメント "
>  strSQL = strSQL & " , TBL.I "
>  strSQL = strSQL & " , TBL.J "
>  strSQL = strSQL & " , TBL.K "
>  strSQL = strSQL & " FROM (" & Me.RecordSource & ") AS TBL "
>  strSQL = strSQL & " WHERE " & strWhere
>  strSQL = strSQL & " ORDER BY TBL.COMM DESC" 'Bを降順で並べ替える
・ツリー全体表示

【11582】Re:フィルタ適用後のEXCEL出力時について
発言  247b  - 10/4/6(火) 12:43 -

引用なし
パスワード
   生成されたSQLを拝見すると、I,J,Kの3項目が、入れ子のSQL(コマンド36_Clickで生成しているSQL)に不足しています。また、エイリアスも不足しているので、一応、書き換え例を以下に記載します。
こちらでは、プログラム実行していない(というかできない)ので、細かなミスがあるかもしれませんが、その点はご勘弁ねがいます。
WHERE句はTrueになっているため、特に条件は存在しないようですので、問題ありません。

1.
Private Sub コマンド36_Click()
Case 2
     strSQL = "select TOHO_TABLE.[COMM]"
       strSQL = sqrSQL & ", TOHO_TABLE.[A]"
       strSQL = sqrSQL & ", TOHO_TABLE.[C]"
       strSQL = sqrSQL & ",TOHO_TABLE.[G]"
       strSQL = sqrSQL & ", TOHO_TABLE.[D]"
       strSQL = sqrSQL & ", TOHO_TABLE.[E]"
       strSQL = sqrSQL & ", TOHO_TABLE.[F]"
       strSQL = sqrSQL & ",TOHO_TABLE.[H]"
       strSQL = sqrSQL & ", TOHO_TABLE.[コメント] "
'追加開始
       strSQL = sqrSQL & ",TOHO_TABLE.[I]"
       strSQL = sqrSQL & ",TOHO_TABLE.[J]"
       strSQL = sqrSQL & ",TOHO_TABLE.[K]"
'追加終了
       strSQL = sqrSQL & " from TOHO_TABLE"
       strSQL = sqrSQL & " WHERE (((TOHO_TABLE.E) In (SELECT Tmp.[E] FROM [TOHO_TABLE] As Tmp "
       strSQL = sqrSQL & " GROUP BY Tmp.[E] HAVING Count(*)>1 )) AND ((TOHO_TABLE.E)<>"""")) "
       strSQL = sqrSQL & " ORDER BY TOHO_TABLE.E DESC "


2.
Private Sub コマンド41_Click()

strSQL = ""
  strSQL = strSQL & " SELECT TBL.A "
  strSQL = strSQL & " , TBL.COMM AS B "
  strSQL = strSQL & " , TBL.C AS 物品名 "
  strSQL = strSQL & " , TBL.D AS 名1 "
  strSQL = strSQL & " , TBL.E AS アドレス "
  strSQL = strSQL & " , TBL.F AS 機会 "
  strSQL = strSQL & " , TBL.G As 名3 "
  strSQL = strSQL & " , TBL.H As 使用者 "
  strSQL = strSQL & " , TBL.コメント "
  strSQL = strSQL & " , TBL.I "
  strSQL = strSQL & " , TBL.J "
  strSQL = strSQL & " , TBL.K "
  strSQL = strSQL & " FROM (" & Me.RecordSource & ") AS TBL "
  strSQL = strSQL & " WHERE " & strWhere
  strSQL = strSQL & " ORDER BY TBL.COMM DESC" 'Bを降順で並べ替える
・ツリー全体表示

【11581】Re:フィルタ適用後のEXCEL出力時について
質問  VBA初心者  - 10/4/6(火) 12:02 -

引用なし
パスワード
   ご丁寧なご回答有難うございます。


>生成されたSQLを見せていただいた方が速いと思います。
>SQLの問題であることは、エラーを見る限り間違いありません。

?strSQL
SELECT A , COMM AS テスト , C AS 名A , D AS 名B , E AS アドレス , F AS 機会番号 , G As 名C , H As 使用者 , コメント , I , J , K FROM (select TEST_TABLE.[COMM], TEST_TABLE.[A], TEST_TABLE.[C], TEST_TABLE.[G], TEST_TABLE.[D], TEST_TABLE.[E], TEST_TABLE.[F], TEST_TABLE.[H], TEST_TABLE.[コメント] from TEST_TABLE WHERE (((TEST_TABLE.E) In (SELECT [E] FROM [TEST_TABLE] As Tmp GROUP BY [E] HAVING Count(*)>1 )) AND ((TEST_TABLE.E)<>""))ORDER BY TEST_TABLE.E DESC ) As TEST_TABLE WHERE True ORDER BY TEST_TABLE.COMM DESC
と記載されておりました。

お手数ですが、よろしくお願いします。

▼247b さん:
>すみません、うまい文章がかけません。分かりにくかったら、読み飛ばして、(C)以降を呼んでください
>
>(A)
>  If Me.Filter = "" Then
>    strWhere = True
>  Else
>    strWhere = Me.Filter
>  End If
>
>上記ロジックが存在すると思いますが、Me.Filterの値をstrWhere変数に代入しています。
>このMe.Filterは、フォームのプロパティのはずで、SQLのWHERE句の「WHERE」を外した部分が
>格納されているはずです。その値が「カラム名=値(又はカラム名)」形式になっているはずです。
>このsteWhereをSQL作成に使用しているため、steWhereに格納されている条件式にもエイリアスが必要となるはずです。「エイリアス.カラム名=値(又はエイリアス.カラム名)」
>値の確認方法は、マウスを変数の上に持っていくか、イミディエイトウィンドウを使用します。(C)を参照
>
>(B)
>「3を指定してください」というエラー自体は
>  Set rs = db.OpenRecordset(strSQL, dbOpenSnapshot)
>の実行時に発生しているはずで、SQLのロジックエラーと理解してください。つまり、SQLとしては成立していないはずです。
>
>(C)
>生成されたSQLを見せていただいた方が速いと思います。
>SQLの問題であることは、エラーを見る限り間違いありません。
>
>どこまでご存知か不明のため、念のため記載します。
>1.以下の行にカーソルを合わせる
>    Set rs = db.OpenRecordset(strSQL, dbOpenSnapshot)
>2.「F9」キーを押す。ブレークポイントが作られ行の背景が茶っぽくなります。
>3.2.までを実行した上で、問題が発生するパターンでプログラムを実行
>4.プログラム実行がブレークポイントで止まります。
>5.イミディエイトウィンドウに「?strSQL」と打って「Enter」
>6.変数内に格納されているSQL文が表示されます。
>※イミディエイトウィンドウが表示されていない場合は、メニューの表示(V)→イミディエイトウィンドウ(I)で表示させます。
・ツリー全体表示

【11580】Re:フィルタ適用後のEXCEL出力時について
発言  247b  - 10/4/5(月) 20:23 -

引用なし
パスワード
   すみません、うまい文章がかけません。分かりにくかったら、読み飛ばして、(C)以降を呼んでください

(A)
  If Me.Filter = "" Then
    strWhere = True
  Else
    strWhere = Me.Filter
  End If

上記ロジックが存在すると思いますが、Me.Filterの値をstrWhere変数に代入しています。
このMe.Filterは、フォームのプロパティのはずで、SQLのWHERE句の「WHERE」を外した部分が
格納されているはずです。その値が「カラム名=値(又はカラム名)」形式になっているはずです。
このsteWhereをSQL作成に使用しているため、steWhereに格納されている条件式にもエイリアスが必要となるはずです。「エイリアス.カラム名=値(又はエイリアス.カラム名)」
値の確認方法は、マウスを変数の上に持っていくか、イミディエイトウィンドウを使用します。(C)を参照

(B)
「3を指定してください」というエラー自体は
  Set rs = db.OpenRecordset(strSQL, dbOpenSnapshot)
の実行時に発生しているはずで、SQLのロジックエラーと理解してください。つまり、SQLとしては成立していないはずです。

(C)
生成されたSQLを見せていただいた方が速いと思います。
SQLの問題であることは、エラーを見る限り間違いありません。

どこまでご存知か不明のため、念のため記載します。
1.以下の行にカーソルを合わせる
    Set rs = db.OpenRecordset(strSQL, dbOpenSnapshot)
2.「F9」キーを押す。ブレークポイントが作られ行の背景が茶っぽくなります。
3.2.までを実行した上で、問題が発生するパターンでプログラムを実行
4.プログラム実行がブレークポイントで止まります。
5.イミディエイトウィンドウに「?strSQL」と打って「Enter」
6.変数内に格納されているSQL文が表示されます。
※イミディエイトウィンドウが表示されていない場合は、メニューの表示(V)→イミディエイトウィンドウ(I)で表示させます。
・ツリー全体表示

【11579】Re:フィルタ適用後のEXCEL出力時について
質問  VBA初心者  - 10/4/5(月) 16:44 -

引用なし
パスワード
   いつもお世話になります。
 
 ご回答有難うございます。

>とりあえず、ORDER BY句が2つ存在しているので、エイリアスの無い方を消してください。
削除して修正しました。

>前回の発言の2は修正されましたか?
>おそらく、strWhere変数にも 「カラム名=値」形式の文字列がセットされていると思うのですが、
>そこを、「エイリアス.カラム名=値」書き換える必要があります。

 どこをどうのように修正するのかさっぱりわかりません。下記に
修正ソースを記載したのですが、エラーメッセージがわかりません。

お忙しい中恐縮ですが、よろしくお願いします。


------------------修正後ソース-------------------------------
Private Sub コマンド41_Click()
  
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strSQL As String
Dim strWhere As String
Dim xlsApp As Object
Dim xlsWkb As Object
Dim xlsFileName As String
Dim i As Long

Dim myDir As String 'デスクトップ定数

  'フィルタを掛けた時点で Hitするものがなかったような場合は
  'メッセージを出して処理を中止します。
  If Me.Recordset.EOF Then
    MsgBox Prompt:="出力するデータがありませぬ" _
       , Buttons:=vbExclamation
    Exit Sub
  End If
  
  'デスクトップを指定
  myDir = CreateObject("WScript.Shell").SpecialFolders("Desktop")

  Set db = CurrentDb
  xlsFileName = myDir & "\" & Format(Date, "yyyy_mm_dd") & "一覧.xls"

  'もし Filterプロパティになにも記述されていなかったら
  'フォームに表示されている全データを出力するようにします。
  If Me.Filter = "" Then
    strWhere = True
  Else
    strWhere = Me.Filter
  End If

'解除ボタンを押した場合は、全データを出力するようにします。
  If Me.FilterOn = False Then
    strWhere = True
   End If


  '変数に SQL文を代入します。
  'Filter プロパティに記述されているものを抽出条件とします。


  strSQL = ""
  strSQL = strSQL & " SELECT A "
  strSQL = strSQL & " , COMM AS テスト "
  strSQL = strSQL & " , C AS 名A "
  strSQL = strSQL & " , D AS 名B "
  strSQL = strSQL & " , E AS アドレス "
  strSQL = strSQL & " , F AS 機会番号 "
  strSQL = strSQL & " , G As 名C "
  strSQL = strSQL & " , H As 使用者 "
  strSQL = strSQL & " , コメント "
  strSQL = strSQL & " , I "
  strSQL = strSQL & " , J "
  strSQL = strSQL & " , K "
  strSQL = strSQL & " FROM (" & Me.RecordSource & ") As TEST_TABLE"
  strSQL = strSQL & " WHERE " & strWhere
  strSQL = strSQL & " ORDER BY TEST_TABLE.COMM DESC"
  
  'レコードセットに対象のデータを代入します
  Set rs = db.OpenRecordset(strSQL, dbOpenSnapshot)


  '以下Excelの操作------------------------------------------
  Set xlsApp = CreateObject("Excel.Application")
    xlsApp.Visible = True
 
  Set xlsWkb = xlsApp.workbooks.Add
    With xlsWkb.Sheets("Sheet1")

     For i = 0 To rs.Fields.Count - 1
       .Range("A1").Offset(0, i).Value = rs.Fields(i).Name
       Debug.Print rs.Fields(i).Name
     Next i
  
    .Range("A2").CopyFromRecordset rs
    .columns("A:K").AutoFit
    End With
  
  
  xlsWkb.SaveAs xlsFileName, FileFormat:=56
  xlsWkb.Close: Set xlsWkb = Nothing
  xlsApp.Quit: Set xlsApp = Nothing
 
  MsgBox "出力しました!!"

  
End Sub

▼247b さん:
>とりあえず、ORDER BY句が2つ存在しているので、エイリアスの無い方を消してください。
>「3を指定してください」の意味は、3カ所、解析できない=不明の文字列が存在するという意味です。
>ORDER BYの不備を直せば、残り2カ所です。
>
>あとはプログラムを見る限り、strWhere変数にセットされている値が問題だと思うのですが。
>前回の発言の2は修正されましたか?
>おそらく、strWhere変数にも 「カラム名=値」形式の文字列がセットされていると思うのですが、
>そこを、「エイリアス.カラム名=値」書き換える必要があります。
>
>あと確認するとすれば、Me.RecordSourceにセットされているSQLに、A〜K、コメントというカラムがSELECTされているかどうかを確認するくらいでしょうか

▼247b さん:
>とりあえず、ORDER BY句が2つ存在しているので、エイリアスの無い方を消してください。
>「3を指定してください」の意味は、3カ所、解析できない=不明の文字列が存在するという意味です。
>ORDER BYの不備を直せば、残り2カ所です。
>
>あとはプログラムを見る限り、strWhere変数にセットされている値が問題だと思うのですが。
>前回の発言の2は修正されましたか?
>おそらく、strWhere変数にも 「カラム名=値」形式の文字列がセットされていると思うのですが、
>そこを、「エイリアス.カラム名=値」書き換える必要があります。
>
>あと確認するとすれば、Me.RecordSourceにセットされているSQLに、A〜K、コメントというカラムがSELECTされているかどうかを確認するくらいでしょうか。
・ツリー全体表示

【11578】Re:フィルタ適用後のEXCEL出力時について
発言  247b  - 10/4/5(月) 15:12 -

引用なし
パスワード
   とりあえず、ORDER BY句が2つ存在しているので、エイリアスの無い方を消してください。
「3を指定してください」の意味は、3カ所、解析できない=不明の文字列が存在するという意味です。
ORDER BYの不備を直せば、残り2カ所です。

あとはプログラムを見る限り、strWhere変数にセットされている値が問題だと思うのですが。
前回の発言の2は修正されましたか?
おそらく、strWhere変数にも 「カラム名=値」形式の文字列がセットされていると思うのですが、
そこを、「エイリアス.カラム名=値」書き換える必要があります。

あと確認するとすれば、Me.RecordSourceにセットされているSQLに、A〜K、コメントというカラムがSELECTされているかどうかを確認するくらいでしょうか。
・ツリー全体表示

【11577】Re:フィルタ適用後のEXCEL出力時について
回答  VBA初心者  - 10/4/5(月) 13:01 -

引用なし
パスワード
   ご丁寧なご回答有難うございます。
 下記にご教授いただいたように修正しましたところ、
 
「1.
strSQL = strSQL & " FROM " & Me.RecordSource & " "

strSQL = strSQL & " FROM (" & Me.RecordSource & ") As TEST_TABLE"

2.
あと、「strWhere」変数の中身にもエイリアスが必要です。

3.
strSQL = strSQL & " ORDER BY COMM DESC"

strSQL = strSQL & " ORDER BY TEST_TABLE .COMM DESC"」
 
 
「実行時エラー'3061'パラメータが少なすぎます。3を指定してください。」
と表示されてしまいます。
 
お手数ですが、ご教授をお願い致します。

----------------------------------------- ソース -------------------------------
Private Sub コマンド41_Click()
 
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strSQL As String
Dim strWhere As String
Dim xlsApp As Object
Dim xlsWkb As Object
Dim xlsFileName As String
Dim i As Long

Dim myDir As String 'デスクトップ定数

  'フィルタを掛けた時点で Hitするものがなかったような場合は
  'メッセージを出して処理を中止します。
  If Me.Recordset.EOF Then
    MsgBox Prompt:="出力するデータがありませぬ" _
       , Buttons:=vbExclamation
    Exit Sub
  End If
  
  'デスクトップを指定
  myDir = CreateObject("WScript.Shell").SpecialFolders("Desktop")

  Set db = CurrentDb
  xlsFileName = myDir & "\" & Format(Date, "yyyy_mm_dd") & "一覧表.xls"

  'もし Filterプロパティになにも記述されていなかったら
  'フォームに表示されている全データを出力するようにします。
  If Me.Filter = "" Then
    strWhere = True
  Else
    strWhere = Me.Filter
  End If

'解除ボタンを押した場合は、全データを出力するようにします。
  If Me.FilterOn = False Then
    strWhere = True
   End If
 
  '変数に SQL文を代入します。
  'Filter プロパティに記述されているものを抽出条件とします。


  strSQL = ""
  strSQL = strSQL & " SELECT TEST_TABLE.[A] "
  strSQL = strSQL & " , TEST_TABLE.[B] AS テスト "
  strSQL = strSQL & " , TEST_TABLE.[C] AS 物品名 "
  strSQL = strSQL & " , TEST_TABLE.[D] AS 名1 "
  strSQL = strSQL & " , TEST_TABLE.[E] AS アドレス "
  strSQL = strSQL & " , TEST_TABLE.[F] AS 機会 "
  strSQL = strSQL & " , TEST_TABLE.[G] As 名3 "
  strSQL = strSQL & " , TEST_TABLE.[H] As 使用者 "
  strSQL = strSQL & " , TEST_TABLE.[コメント] "
  strSQL = strSQL & " , TEST_TABLE.[I] "
  strSQL = strSQL & " , TEST_TABLE.[J] "
  strSQL = strSQL & " , TEST_TABLE.[K] "
  strSQL = strSQL & " FROM (" & Me.RecordSource & ") As TEST_TABLE"
  strSQL = strSQL & " WHERE " & strWhere
  strSQL = strSQL & " ORDER BY COMM DESC" 'Bを降順で並べ替える
  strSQL = strSQL & " ORDER BY TEST_TABLE.COMM DESC"
  

  'レコードセットに対象のデータを代入します
  Set rs = db.OpenRecordset(strSQL, dbOpenSnapshot)


  '以下Excelの操作------------------------------------------
  Set xlsApp = CreateObject("Excel.Application")
    xlsApp.Visible = True
 
  Set xlsWkb = xlsApp.workbooks.Add
    With xlsWkb.Sheets("Sheet1")

     For i = 0 To rs.Fields.Count - 1
       .Range("A1").Offset(0, i).Value = rs.Fields(i).Name
       Debug.Print rs.Fields(i).Name
     Next i
  
    .Range("A2").CopyFromRecordset rs
    .columns("A:K").AutoFit
    End With
  
  
  xlsWkb.SaveAs xlsFileName, FileFormat:=56
  xlsWkb.Close: Set xlsWkb = Nothing
  xlsApp.Quit: Set xlsApp = Nothing
 
  MsgBox "出力しました!!"

  
End Sub
-----------------------------------------------------------


▼247b さん:
>おつかれさまです。
>ちょっと言葉足らずだったかも知れません。すみません。
>
>1.
>strSQL = strSQL & " FROM " & Me.RecordSource & " "
>↓
>strSQL = strSQL & " FROM (" & Me.RecordSource & ") As TEST_TABLE"
>
>2.
>あと、「strWhere」変数の中身にもエイリアスが必要です。
>
>3.
>strSQL = strSQL & " ORDER BY COMM DESC"
>↓
>strSQL = strSQL & " ORDER BY TEST_TABLE .COMM DESC"
>
>とりあえず、これで試していただいて、もしだめなら、strSQL変数の中のSQLを見せてもらえますか。
>よろしくお願いします。
・ツリー全体表示

【11576】Re:フィルタ適用後のEXCEL出力時について
発言  247b  - 10/4/5(月) 11:05 -

引用なし
パスワード
   おつかれさまです。
ちょっと言葉足らずだったかも知れません。すみません。

1.
strSQL = strSQL & " FROM " & Me.RecordSource & " "

strSQL = strSQL & " FROM (" & Me.RecordSource & ") As TEST_TABLE"

2.
あと、「strWhere」変数の中身にもエイリアスが必要です。

3.
strSQL = strSQL & " ORDER BY COMM DESC"

strSQL = strSQL & " ORDER BY TEST_TABLE .COMM DESC"

とりあえず、これで試していただいて、もしだめなら、strSQL変数の中のSQLを見せてもらえますか。
よろしくお願いします。
・ツリー全体表示

【11575】Re:フィルタ適用後のEXCEL出力時について
質問  VBA初心者  - 10/4/5(月) 10:36 -

引用なし
パスワード
   いつもお世話になります。


 ソースコードの中に、誤りがありましたので訂正します。
コマンド41_Click()時のソースをフィールド名を表示する場所に、
エイリアスを挿入したのですが、エラー表示がかわりません。
 お手数ですが、ご教授をよろしくお願いします。
 
以上、よろしくお願いします。


'1.「表示」ボタンクリック時-----------------------------------------------------------

Private Sub コマンド36_Click()

Me.RecordSource = frmRecSource
  Me.Requery

End Sub
-----------------------------------------------------------


'2.オプション抽出条件-----------------------------------------------------------
Function frmRecSource() As String
  Dim strSQL As String
  
  Select Case Me.フレーム54
  Case 1
    strSQL = "select * " _
      & "from TEST_TABLE "
  Case 2
     strSQL = "select TEST_TABLE.[COMM], TEST_TABLE.[A], TEST_TABLE.[C], " _
      & "TEST_TABLE.[G], TEST_TABLE.[D], TEST_TABLE.[E], TEST_TABLE.[F], " _
      & "TEST_TABLE.[H], TEST_TABLE.[コメント] " _
      & "from TEST_TABLE " _
      & "WHERE (((TEST_TABLE.E) In (SELECT [E] FROM [TEST_TABLE] As Tmp GROUP BY [E] HAVING Count(*)>1 )) AND ((TEST_TABLE.E)<>""""))" _
      & "ORDER BY TEST_TABLE.E DESC "


  End Select
  
  Debug.Print strSQL
  frmRecSource = strSQL
  
End Function

-----------------------------------------------------------


'3.エクセル出力-----------------------------------------------------------
Private Sub コマンド41_Click()
 
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strSQL As String
Dim strWhere As String
Dim xlsApp As Object
Dim xlsWkb As Object
Dim xlsFileName As String
Dim i As Long

Dim myDir As String 'デスクトップ定数

  'フィルタを掛けた時点で Hitするものがなかったような場合は
  'メッセージを出して処理を中止します。
  If Me.Recordset.EOF Then
    MsgBox Prompt:="出力するデータがありませぬ" _
       , Buttons:=vbExclamation
    Exit Sub
  End If
  
  'デスクトップを指定
  myDir = CreateObject("WScript.Shell").SpecialFolders("Desktop")

  Set db = CurrentDb
  xlsFileName = myDir & "\" & Format(Date, "yyyy_mm_dd") & "一覧表.xls"

  'もし Filterプロパティになにも記述されていなかったら
  'フォームに表示されている全データを出力するようにします。
  If Me.Filter = "" Then
    strWhere = True
  Else
    strWhere = Me.Filter
  End If

'解除ボタンを押した場合は、全データを出力するようにします。
  If Me.FilterOn = False Then
    strWhere = True
   End If
 
  '変数に SQL文を代入します。
  'Filter プロパティに記述されているものを抽出条件とします。


  strSQL = ""
  strSQL = strSQL & " SELECT TEST_TABLE.[A] "
  strSQL = strSQL & " , TEST_TABLE.[B] AS テスト "
  strSQL = strSQL & " , TEST_TABLE.[C] AS 物品名 "
  strSQL = strSQL & " , TEST_TABLE.[D] AS 名1 "
  strSQL = strSQL & " , TEST_TABLE.[E] AS アドレス "
  strSQL = strSQL & " , TEST_TABLE.[F] AS 機会 "
  strSQL = strSQL & " , TEST_TABLE.[G] As 名3 "
  strSQL = strSQL & " , TEST_TABLE.[H] As 使用者 "
  strSQL = strSQL & " , TEST_TABLE.[コメント] "
  strSQL = strSQL & " , TEST_TABLE.[I] "
  strSQL = strSQL & " , TEST_TABLE.[J] "
  strSQL = strSQL & " , TEST_TABLE.[K] "
  strSQL = strSQL & " FROM " & Me.RecordSource & " "
  strSQL = strSQL & " WHERE " & strWhere
  strSQL = strSQL & " ORDER BY COMM DESC" 'Bを降順で並べ替える

  
  'レコードセットに対象のデータを代入します
  Set rs = db.OpenRecordset(strSQL, dbOpenSnapshot)


  '以下Excelの操作------------------------------------------
  Set xlsApp = CreateObject("Excel.Application")
    xlsApp.Visible = True
 
  Set xlsWkb = xlsApp.workbooks.Add
    With xlsWkb.Sheets("Sheet1")

     For i = 0 To rs.Fields.Count - 1
       .Range("A1").Offset(0, i).Value = rs.Fields(i).Name
       Debug.Print rs.Fields(i).Name
     Next i
  
    .Range("A2").CopyFromRecordset rs
    .columns("A:K").AutoFit
    End With
  
  
  xlsWkb.SaveAs xlsFileName, FileFormat:=56
  xlsWkb.Close: Set xlsWkb = Nothing
  xlsApp.Quit: Set xlsApp = Nothing
 
  MsgBox "出力しました!!"

  
End Sub
-----------------------------------------------------------


▼247b さん:
>おつかれさまです。
>
>frmRecSourceプロシージャのCase文の、
>case1の場合は問題なく、
>case2の場合に問題あり、ということでよろしいでしょうか。
>
>とりあえず、さっとテストしてみただけなのですが、
>コマンド41_ClickプロシージャのSQL生成ロジックで、FROM句にしているSQLに対してエイリアス
>が必要ではないかと思われます。このため、SELECT句の各項目にもエイリアスが必要です。
>
>SELECT句を「*」で指定した場合は、問題ないようなのですが、
>SELECT句をカラム名で指定した場合、そのSELECT文をFROM句にネスト(入れ子)させると
>構文エラーが発生するようです。
・ツリー全体表示

【11574】Re:長さゼロの値をフォームに非表示にし...
お礼  VBA初心者  - 10/4/5(月) 9:00 -

引用なし
パスワード
   ご丁寧なご回答有難うございます。
理解致しました。
 今後とも何卒よろしくお願いします。

以上、よろしくお願いします。

▼よろずや さん:
>VBAプログラムの中では文字列を"(ダブルクォーテション)で括ります。
>その中の文字列に"(ダブルクォーテション)が含まれていたら
>文字列がそこで終わってしまいますよね。
>そこで、文字列中の"(ダブルクォーテション)は2個続けて記述することにより
>文字列の終了ではなく文字列中の"(ダブルクォーテション)であるとみなす
>約束事があります。

・ツリー全体表示

【11573】Re:長さゼロの値をフォームに非表示にし...
回答  よろずや  - 10/4/3(土) 10:35 -

引用なし
パスワード
   VBAプログラムの中では文字列を"(ダブルクォーテション)で括ります。
その中の文字列に"(ダブルクォーテション)が含まれていたら
文字列がそこで終わってしまいますよね。
そこで、文字列中の"(ダブルクォーテション)は2個続けて記述することにより
文字列の終了ではなく文字列中の"(ダブルクォーテション)であるとみなす
約束事があります。
・ツリー全体表示

【11572】Re:フィルタ適用後のEXCEL出力時について
発言  247b  - 10/4/2(金) 17:29 -

引用なし
パスワード
   おつかれさまです。

frmRecSourceプロシージャのCase文の、
case1の場合は問題なく、
case2の場合に問題あり、ということでよろしいでしょうか。

とりあえず、さっとテストしてみただけなのですが、
コマンド41_ClickプロシージャのSQL生成ロジックで、FROM句にしているSQLに対してエイリアス
が必要ではないかと思われます。このため、SELECT句の各項目にもエイリアスが必要です。

SELECT句を「*」で指定した場合は、問題ないようなのですが、
SELECT句をカラム名で指定した場合、そのSELECT文をFROM句にネスト(入れ子)させると
構文エラーが発生するようです。
・ツリー全体表示

【11571】フィルタ適用後のEXCEL出力時について
質問  VBA初心者  - 10/4/2(金) 17:08 -

引用なし
パスワード
   いつもお世話になります。
 下記のコマンドにてフレームを作成して、条件毎にフォーム上に表示させております。(1.2.)
その他、3.のように別の条件でも抽出して、フォーム上のデータをフィルタかけた状態で
エクセルに出力するようにしております。
 しかし、一度1.2.を実行した後、3.を実行すると、「実行時エラー'3131'FROM句の構文エラーです。」
と表示されてしまいます。
 1.2.を実行しないで3.を実行すると、何もエラーが出ないでEXCELに出力されます。
どこが間違っているのか解りません。
 どうかご教授をお願い致します。  


'1.「表示」ボタンクリック時-----------------------------------------------------------

Private Sub コマンド36_Click()

Me.RecordSource = frmRecSource
  Me.Requery

End Sub
-----------------------------------------------------------


'2.オプション抽出条件-----------------------------------------------------------
Function frmRecSource() As String
  Dim strSQL As String
  
  Select Case Me.フレーム54
  Case 1
    strSQL = "select * " _
      & "from TOHO_TABLE "
  Case 2
     strSQL = "select TOHO_TABLE.[COMM], TOHO_TABLE.[A], TOHO_TABLE.[C], " _
      & "TOHO_TABLE.[G], TOHO_TABLE.[D], TOHO_TABLE.[E], TOHO_TABLE.[F], " _
      & "TOHO_TABLE.[H], TOHO_TABLE.[コメント] " _
      & "from TOHO_TABLE " _
      & "WHERE (((TOHO_TABLE.E) In (SELECT [E] FROM [TOHO_TABLE] As Tmp GROUP BY [E] HAVING Count(*)>1 )) AND ((TOHO_TABLE.E)<>""""))" _
      & "ORDER BY TOHO_TABLE.E DESC "


  End Select
  
  Debug.Print strSQL
  frmRecSource = strSQL
  
End Function

-----------------------------------------------------------


'3.エクセル出力-----------------------------------------------------------
Private Sub コマンド41_Click()
 
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strSQL As String
Dim strWhere As String
Dim xlsApp As Object
Dim xlsWkb As Object
Dim xlsFileName As String
Dim i As Long

Dim myDir As String 'デスクトップ定数

  'フィルタを掛けた時点で Hitするものがなかったような場合は
  'メッセージを出して処理を中止します。
  If Me.Recordset.EOF Then
    MsgBox Prompt:="出力するデータがありませぬ" _
       , Buttons:=vbExclamation
    Exit Sub
  End If
  
  'デスクトップを指定
  myDir = CreateObject("WScript.Shell").SpecialFolders("Desktop")

  Set db = CurrentDb
  xlsFileName = myDir & "\" & Format(Date, "yyyy_mm_dd") & "一覧表.xls"

  'もし Filterプロパティになにも記述されていなかったら
  'フォームに表示されている全データを出力するようにします。
  If Me.Filter = "" Then
    strWhere = True
  Else
    strWhere = Me.Filter
  End If

'解除ボタンを押した場合は、全データを出力するようにします。
  If Me.FilterOn = False Then
    strWhere = True
   End If
 
  '変数に SQL文を代入します。
  'Filter プロパティに記述されているものを抽出条件とします。


  strSQL = ""
  strSQL = strSQL & " SELECT A "
  strSQL = strSQL & " , COMM AS B "
  strSQL = strSQL & " , C AS 物品名 "
  strSQL = strSQL & " , D AS 名1 "
  strSQL = strSQL & " , E AS アドレス "
  strSQL = strSQL & " , F AS 機会 "
  strSQL = strSQL & " , G As 名3 "
  strSQL = strSQL & " , H As 使用者 "
  strSQL = strSQL & " , コメント "
  strSQL = strSQL & " , I "
  strSQL = strSQL & " , J "
  strSQL = strSQL & " , K "
  strSQL = strSQL & " FROM " & Me.RecordSource & " "
  strSQL = strSQL & " WHERE " & strWhere
  strSQL = strSQL & " ORDER BY COMM DESC" 'Bを降順で並べ替える

  
  'レコードセットに対象のデータを代入します
  Set rs = db.OpenRecordset(strSQL, dbOpenSnapshot)


  '以下Excelの操作------------------------------------------
  Set xlsApp = CreateObject("Excel.Application")
    xlsApp.Visible = True
 
  Set xlsWkb = xlsApp.workbooks.Add
    With xlsWkb.Sheets("Sheet1")

     For i = 0 To rs.Fields.Count - 1
       .Range("A1").Offset(0, i).Value = rs.Fields(i).Name
       Debug.Print rs.Fields(i).Name
     Next i
  
    .Range("A2").CopyFromRecordset rs
    .columns("A:K").AutoFit
    End With
  
  
  xlsWkb.SaveAs xlsFileName, FileFormat:=56
  xlsWkb.Close: Set xlsWkb = Nothing
  xlsApp.Quit: Set xlsApp = Nothing
 
  MsgBox "出力しました!!"

  
End Sub
-----------------------------------------------------------
・ツリー全体表示

【11570】Re:CreateObjectの後にマウスポインタが...
回答  ぽんぽん  - 10/4/2(金) 16:33 -

引用なし
パスワード
   >CreateObject("Access.Applicaction")を実行した後で、
>砂時計にしていたマウスポインタが
>デフォルトに戻ってしまうという現象があります。

すみません、自己レスです。

CreateObjectを、GetObjectにしましたところ、
解決しました。

お騒がせ致しました。。。
・ツリー全体表示

【11569】CreateObjectの後にマウスポインタがデフ...
質問  ぽんぽん  - 10/4/2(金) 14:55 -

引用なし
パスワード
   【開発環境】
・Access2007
・WindowsXP

CreateObject("Access.Applicaction")を実行した後で、
砂時計にしていたマウスポインタが
デフォルトに戻ってしまうという現象があります。

-------------------------------------------------------------------

  〜処理(省略)〜

  Screen.MousePointer = ccHourglass

  〜処理(省略)〜

  Set acApp = CreateObject("Access.Application")
  ↑ここで砂時計がデフォルトに変わる
  acApp.OpenCurrentDatabase "C:\hoge\hoge.accdb"

  〜処理(省略)〜

  Screen.MousePointer = ccDefault

-------------------------------------------------------------------

CreateObjectの後に、
Screen.MousePointer = ccHourglass
を挿入してもデフォルトのままなのです。。。

ご存知の方、回避方法をご教授ください。
・ツリー全体表示

【11568】Re:長さゼロの値をフォームに非表示にし...
質問  VBA初心者  - 10/4/2(金) 8:47 -

引用なし
パスワード
   ▼よろずや さん:
>試してないけど
> AND ((test_TABLE.F)<>""""))" _


有難うございます。

AND ((test_TABLE.F)<>""""))"
にて成功しました。
 長さゼロ値でないは、クエリにて「<>""」でしたがVBAだと記述が変わるのでしょうか。
初心者的な質問で恐縮ですが、ご教授をお願いします。
 

--------------------------------VBAソース----------------------------------------------------------
Function frmRecSource() As String
  Dim strSQL As String
  
  Select Case Me.フレーム54
  Case 1
    strSQL = "select * " _
      & "from test_TABLE "
  Case 2
     strSQL = "select test_TABLE.[A], test_TABLE.[B], test_TABLE.[C], " _
      & "test_TABLE.[D], test_TABLE.[E], test_TABLE.[F], test_TABLE.[G], " _
      & "test_TABLE.[H], test_TABLE.[I] " _
      & "from test_TABLE " _
      & "WHERE (((test_TABLE.F) In (SELECT [F] FROM [test_TABLE] As Tmp GROUP BY [F] HAVING Count(*)>1 )) AND ((test_TABLE.F)<>""""))" _
      & "ORDER BY test_TABLE.F DESC "

  End Select
  
  Debug.Print strSQL
  frmRecSource = strSQL
  
End Function

-----------------------------------------------------------------------------------------------------
・ツリー全体表示

【11567】Re:長さゼロの値をフォームに非表示にし...
回答  よろずや  - 10/4/1(木) 20:46 -

引用なし
パスワード
   試してないけど
AND ((test_TABLE.F)<>""""))" _
・ツリー全体表示

【11566】長さゼロの値をフォームに非表示にしたい
質問  VBA初心者  - 10/4/1(木) 17:06 -

引用なし
パスワード
   いつもお世話になります。
 下記のように「testテーブル」のF列が重複している場合のデータをフォーム上に表示させようと
しております。
 F列に長さゼロの値が入っている場合は表示させないようにしたいのですが、実行すると
「構文エラー/演算子がありません」とエラーメッセージが表示されてしまいます。
 「'」でコメント化している記述を使うとエラーにはなりませんが、「長さゼロの値」も表示させれて
しまいます。
 表示させないようにするにはどのようにしたらよろしいでしょうか。
 
どうかご教授をよろしくお願いします。


Function frmRecSource() As String
  Dim strSQL As String
  
  Select Case Me.フレーム54
  Case 1
    strSQL = "select * " _
      & "from test_TABLE "
  Case 2
     strSQL = "select test_TABLE.[A], test_TABLE.[B], test_TABLE.[C], " _
      & "test_TABLE.[D], test_TABLE.[E], test_TABLE.[F], test_TABLE.[G], " _
      & "test_TABLE.[H], test_TABLE.[I] " _
      & "from test_TABLE " _
      & "WHERE (((test_TABLE.F) In (SELECT [F] FROM [test_TABLE] As Tmp GROUP BY [F] HAVING Count(*)>1 )) AND ((test_TABLE.F)<>""))""" _
      & "ORDER BY test_TABLE.F DESC "


    'strSQL = "select test_TABLE.[A], test_TABLE.[B], test_TABLE.[C], " _
    '  & "test_TABLE.[D], test_TABLE.[E], test_TABLE.[F], test_TABLE.[G], " _
    '  & "test_TABLE.[H], test_TABLE.[I] " _
    '  & "from test_TABLE " _
    '  & "WHERE (((test_TABLE.[F]) In (SELECT [F] FROM [test_TABLE] As Tmp GROUP BY [F] HAVING Count(*)>1 ))) " _
    '  & "ORDER BY test_TABLE.F "
  End Select
  
  Debug.Print strSQL
  frmRecSource = strSQL
  
End Function
・ツリー全体表示

【11565】Re:Excel出力時の条件について
お礼  VBA初心者  - 10/4/1(木) 16:54 -

引用なし
パスワード
   ご回答ありがとうございます。
 とりあえず、データが10行のものを集計しているので、
excelで出力してから修正します。
>Cstr(0.9*100)&"%"として、チャレンジしてみます。

有難うございました。

▼247b さん:
>おつかれさまです。
>
>状況が今ひとつ掴めないのですが、経験的にいって、条件が足りないと聞かれる場合は、クエリに解析できない変数が存在していることが多いです。
>プログラムを拝見するかぎり、クエリ1のSQLに何か問題がないでしょうか。
>
>パーセント表記については、もっと良い方策があると思いますが、すぐに思いつくのは、SQLの項目を
>Cstr(0.9*100)&"%" とすれば行けるはずです。実際には0.9をカラム名に置き換えます。
>ただし、この方式だと、データ量が多いと処理に時間がかかります。
・ツリー全体表示

86 / 500 ページ ←次へ | 前へ→
ページ:  ┃  記事番号:
1082668
(SS)C-BOARD v3.8 is Free