Access VBA質問箱 IV

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

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


461 / 2272 ツリー ←次へ | 前へ→

【11571】フィルタ適用後のEXCEL出力時について VBA初心者 10/4/2(金) 17:08 質問[未読]
【11572】Re:フィルタ適用後のEXCEL出力時について 247b 10/4/2(金) 17:29 発言[未読]
【11575】Re:フィルタ適用後のEXCEL出力時について VBA初心者 10/4/5(月) 10:36 質問[未読]
【11576】Re:フィルタ適用後のEXCEL出力時について 247b 10/4/5(月) 11:05 発言[未読]
【11577】Re:フィルタ適用後のEXCEL出力時について VBA初心者 10/4/5(月) 13:01 回答[未読]
【11578】Re:フィルタ適用後のEXCEL出力時について 247b 10/4/5(月) 15:12 発言[未読]
【11579】Re:フィルタ適用後のEXCEL出力時について VBA初心者 10/4/5(月) 16:44 質問[未読]
【11580】Re:フィルタ適用後のEXCEL出力時について 247b 10/4/5(月) 20:23 発言[未読]
【11581】Re:フィルタ適用後のEXCEL出力時について VBA初心者 10/4/6(火) 12:02 質問[未読]
【11582】Re:フィルタ適用後のEXCEL出力時について 247b 10/4/6(火) 12:43 発言[未読]
【11583】Re:フィルタ適用後のEXCEL出力時について VBA初心者 10/4/6(火) 14:28 質問[未読]
【11584】Re:フィルタ適用後のEXCEL出力時について 247b 10/4/6(火) 16:17 発言[未読]
【11585】Re:フィルタ適用後のEXCEL出力時について VBA初心者 10/4/6(火) 18:16 質問[未読]
【11586】Re:フィルタ適用後のEXCEL出力時について 247b 10/4/6(火) 18:53 発言[未読]
【11587】Re:フィルタ適用後のEXCEL出力時について VBA初心者 10/4/7(水) 11:13 質問[未読]
【11589】Re:フィルタ適用後のEXCEL出力時について 247b 10/4/7(水) 13:00 発言[未読]
【11590】Re:フィルタ適用後のEXCEL出力時について VBA初心者 10/4/7(水) 13:53 回答[未読]
【11591】Re:フィルタ適用後のEXCEL出力時について 247b 10/4/7(水) 14:17 発言[未読]
【11592】Re:フィルタ適用後のEXCEL出力時について VBA初心者 10/4/7(水) 14:56 お礼[未読]
【11593】Re:フィルタ適用後のEXCEL出力時について 247b 10/4/7(水) 15:25 発言[未読]
【11597】Re:フィルタ適用後のEXCEL出力時について VBA初心者 10/4/8(木) 10:06 お礼[未読]

【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
-----------------------------------------------------------

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

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

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

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

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

【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句にネスト(入れ子)させると
>構文エラーが発生するようです。

【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を見せてもらえますか。
よろしくお願いします。

【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を見せてもらえますか。
>よろしくお願いします。

【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されているかどうかを確認するくらいでしょうか。

【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されているかどうかを確認するくらいでしょうか。

【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)で表示させます。

【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)で表示させます。

【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を降順で並べ替える

【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を降順で並べ替える

【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

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

引用なし
パスワード
   いつもお世話になります。
 下記の
>コマンド36_Click のCase2のSQLですが、以下のもので置き換え可能ですか?
>問題ない場合、これを使ってプログラム実行してみてください
を試してみましたが、下記の場所にて「演算子がありません。」とエラー表示
されてしまいます。

--------------VBA----------------------------------------------
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
--------------------------------------------------------------------
上記の条件を外すとエラーは表示されなですが。欲しいデータが取れません。
 誠に申し訳ないですが、よろしくお願いします。
 
▼247b さん:
>机上デバッグでは埒があかないので、カラム名を同じにしたテーブルを使用して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

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

引用なし
パスワード
   また、ACCESSSのバージョンは何ですか? Access2000だとSQLが動かない可能性があります。
こちらの検証環境は2003です。

こちらの環境ではエラーが発生しないことを確認しています。
このため、「演算子がありません」というエラーも出ていません。
SQLをVBAに埋め込む際ににミスってたりしませんか?

【11587】Re:フィルタ適用後のEXCEL出力時について
質問  VBA初心者  - 10/4/7(水) 11:13 -

引用なし
パスワード
   お世話様です。

ACCESSSのバージョンは2007です。

>SQLをVBAに埋め込む際ににミスってたりしませんか?

--------------VBA----------------------------------------------
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
--------------------------------------------------------------------
のソースを記述しました。
お忙しい中恐縮ですが、よろしくお願いします。

▼247b さん:
>また、ACCESSSのバージョンは何ですか? Access2000だとSQLが動かない可能性があります。
>こちらの検証環境は2003です。
>
>こちらの環境ではエラーが発生しないことを確認しています。
>このため、「演算子がありません」というエラーも出ていません。
>SQLをVBAに埋め込む際ににミスってたりしませんか?

【11589】Re:フィルタ適用後のEXCEL出力時について
発言  247b  - 10/4/7(水) 13:00 -

引用なし
パスワード
   最新のVBAプログラムを見せてください。

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

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

下記にソースを記述します。
 フレームで条件を抽出する場合と「コマンド38_Click」
をクリックした時の検索条件にて値を抽出するようにしてます。


お手数ですが、よろしくお願いします。 
---------------------VBAソース-------------------------------

Private Sub コマンド36_Click()----フレームの抽出条件

Me.RecordSource = frmRecSource
  Me.Requery
 

End Sub

Function frmRecSource() As String-----Function関数
  Dim strSQL As String
 
  Dim strWH As String
  
  Select Case Me.フレーム54
  Case 1
     strSQL = "select * " _
      & "from TEST_TABLE "
  Case 2
      
     strSQL = "select TEST_TABLE.[A]"
        strSQL = strSQL & ", TEST_TABLE.[B]"
        strSQL = strSQL & ", TEST_TABLE.[C]"
        strSQL = strSQL & ", TEST_TABLE.[D]"
        strSQL = strSQL & ", TEST_TABLE.[E]"
        strSQL = strSQL & ", TEST_TABLE.[F]"
        strSQL = strSQL & ", TEST_TABLE.[G]"
        strSQL = strSQL & ", TEST_TABLE.[H]"
        strSQL = strSQL & ", TEST_TABLE.[I]"
        strSQL = strSQL & ", TEST_TABLE.[J]"
        strSQL = strSQL & ", TEST_TABLE.[K]"
        strSQL = strSQL & ", TEST_TABLE.[L]"
        strSQL = strSQL & " from TEST_TABLE"
       
       
        strSQL = strSQL & " WHERE (((TEST_TABLE.E In (SELECT TEST_TABLE.E FROM (SELECT COUNT(*),TEST_TABLE.E FROM TEST_TABLE As TEST_TABLE  "
        strSQL = strSQL & " GROUP BY TEST_TABLE.E HAVING Count(*)>1 ) AS TEST_TABLE) AND TEST_TABLE.E<>'' "
        strSQL = strSQL & " ORDER BY TEST_TABLE.E DESC "
    
  End Select
  
  Debug.Print strSQL
  frmRecSource = strSQL
  
End Function


Private Sub コマンド38_Click()------検索ボタン

Dim strWH As String

  strWH = "(A Like '*" & Me.テキスト36 & "*')" _
    & " OR (B Like '*" & Me.テキスト36 & "*')" _
    & " OR (C Like '*" & Me.テキスト36 & "*')" _
    & " OR (D Like '*" & Me.テキスト36 & "*')" _
    & " OR (E Like '*" & Me.テキスト36 & "*')" _
    & " OR (F Like '*" & Me.テキスト36 & "*')" _
    & " OR (G Like '*" & Me.テキスト36 & "*')" _
    & " OR (H Like '*" & Me.テキスト36 & "*')" _
    & " OR (I Like '*" & Me.テキスト36 & "*')"


  Me.Filter = strWH
  Me.FilterOn = True


Private Sub コマンド41_Click()--------------Excel出力
  
'On Error GoTo Err_コマンド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 C "
  strSQL = strSQL & " , A AS 事業所名 "
  strSQL = strSQL & " , B AS PC名 "
  strSQL = strSQL & " , D AS セグメント名 "
  strSQL = strSQL & " , E AS IPアドレス "
  strSQL = strSQL & " , F AS 機種 "
  strSQL = strSQL & " , G As ドメイン名 "
  strSQL = strSQL & " , H As 使用者 "
  strSQL = strSQL & " , I "
  strSQL = strSQL & " , J "
  strSQL = strSQL & " , K "
  strSQL = strSQL & " , L "
  'strSQL = strSQL & " FROM " & Me.RecordSource & " "
  strSQL = strSQL & " FROM (" & Me.RecordSource & ") As TEST_TABLE"
  strSQL = strSQL & " WHERE " & strWhere
  'strSQL = strSQL & " ORDER BY A DESC" '名を降順で並べ替える
  strSQL = strSQL & " ORDER BY TEST_TABLE.A 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 "出力しました!!"

  
Exit_コマンド41_Click:
  Exit Sub

Err_コマンド41_Click:
  MsgBox "出力できません!管理者に確認!!"
  Resume Exit_コマンド41_Click
  
  
End Sub


▼247b さん:
>最新のVBAプログラムを見せてください。

【11591】Re:フィルタ適用後のEXCEL出力時について
発言  247b  - 10/4/7(水) 14:17 -

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

コマンド36_Click()プロシージャのCase2のSQL文で、

strSQL = strSQL & " WHERE (((TEST_TABLE.E In (SELECT TEST_TABLE.E FROM (SELECT COUNT(*),TEST_TABLE.E FROM TEST_TABLE As TEST_TABLE  "

の中の

SELECT TEST_TABLE.E FROM (SELECT COUNT(*),TEST_TABLE.E FROM TEST_TABLE As TEST_TABLE

のSQLのFROMに指定しているテーブル名が「TEST_TABLE」になっていますが。「TOHO_TABLE」が正しくはないですか?

前回の発言のVBA文はTOHO_TABLEになっていますよね。

【11592】Re:フィルタ適用後のEXCEL出力時について
お礼  VBA初心者  - 10/4/7(水) 14:56 -

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

>前回の発言のVBA文はTEST_TABLEになっていますよね。
はいそうです。一般的にするのに「TOHO_TABLE」から「TEST_TABLE」
にしました。混乱を招きごめんなさい。

ケース2を修正した結果正しく動作しました。

Case 2
      
     strSQL = "select TEST_TABLE.[A]"
        strSQL = strSQL & ", TEST_TABLE.[B]"
        strSQL = strSQL & ", TEST_TABLE.[C]"
        strSQL = strSQL & ", TEST_TABLE.[D]"
        strSQL = strSQL & ", TEST_TABLE.[E]"
        strSQL = strSQL & ", TEST_TABLE.[F]"
        strSQL = strSQL & ", TEST_TABLE.[G]"
        strSQL = strSQL & ", TEST_TABLE.[H]"
        strSQL = strSQL & ", TEST_TABLE.[I]"
        strSQL = strSQL & ", TEST_TABLE.[J]"
        strSQL = strSQL & ", TEST_TABLE.[K]"
        strSQL = strSQL & ", TEST_TABLE.[L]"
        strSQL = strSQL & " from TEST_TABLE"
        strSQL = strSQL & " WHERE (((TEST_TABLE.[E]) In (SELECT [E] FROM [TEST_TABLE] As Tmp GROUP BY [E] HAVING Count(*)>1 )) AND ((TEST_TABLE.E)<>''))"
        strSQL = strSQL & " ORDER BY TEST_TABLE.[E] "


お忙しい中、ご対応いただき誠に有難うございました。
 今後ともよろしくお願い致します。


▼247b さん:
>おつかれさまです。
>
>コマンド36_Click()プロシージャのCase2のSQL文で、
>
>strSQL = strSQL & " WHERE (((TEST_TABLE.E In (SELECT TEST_TABLE.E FROM (SELECT COUNT(*),TEST_TABLE.E FROM TEST_TABLE As TEST_TABLE  "
>
>の中の
>
>SELECT TEST_TABLE.E FROM (SELECT COUNT(*),TEST_TABLE.E FROM TEST_TABLE As TEST_TABLE
>
>のSQLのFROMに指定しているテーブル名が「TEST_TABLE」になっていますが。「TEST_TABLE」が正しくはないですか?
>
>前回の発言のVBA文はTEST_TABLEになっていますよね。

【11593】Re:フィルタ適用後のEXCEL出力時について
発言  247b  - 10/4/7(水) 15:25 -

引用なし
パスワード
   とりあえず、うまく行ったようで、なによりでした。
結構、時間かかってしまいましたね。

今回は乗りかかった船ということもあり、最後までおつきあいしましたが、
VBA初心者さんの経験年数がどのくらいか存じ上げないので、なんとも言えない
部分もありますが、もう少し、じっくりプログラムを見てみることをお勧めします。

とはいえ、分からないのに悩み続けるのも時間の無駄です。
また機会があったらよろしくお願いします。

【11597】Re:フィルタ適用後のEXCEL出力時について
お礼  VBA初心者  - 10/4/8(木) 10:06 -

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

 今後とも何卒ご教授をお願い致します。
自分なりにもう少しじっくりプログラムを見て
から質問するように心がけます。

有難うございました。

▼247b さん:
>とりあえず、うまく行ったようで、なによりでした。
>結構、時間かかってしまいましたね。
>
>今回は乗りかかった船ということもあり、最後までおつきあいしましたが、
>VBA初心者さんの経験年数がどのくらいか存じ上げないので、なんとも言えない
>部分もありますが、もう少し、じっくりプログラムを見てみることをお勧めします。
>
>とはいえ、分からないのに悩み続けるのも時間の無駄です。
>また機会があったらよろしくお願いします。

461 / 2272 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
1078193
(SS)C-BOARD v3.8 is Free