| |
ご丁寧なご回答有難うございます。
下記にご教授いただいたように修正しましたところ、
「１．
strSQL = strSQL & " FROM " & Me.RecordSource & " "
↓
strSQL = strSQL & " FROM (" & Me.RecordSource & ") As TEST_TABLE"
２．
あと、「strWhere」変数の中身にもエイリアスが必要です。
３．
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 さん：
>おつかれさまです。
>ちょっと言葉足らずだったかも知れません。すみません。
>
>１．
>strSQL = strSQL & " FROM " & Me.RecordSource & " "
>↓
>strSQL = strSQL & " FROM (" & Me.RecordSource & ") As TEST_TABLE"
>
>２．
>あと、「strWhere」変数の中身にもエイリアスが必要です。
>
>３．
>strSQL = strSQL & " ORDER BY COMM DESC"
>↓
>strSQL = strSQL & " ORDER BY TEST_TABLE .COMM DESC"
>
>とりあえず、これで試していただいて、もしだめなら、strSQL変数の中のSQLを見せてもらえますか。
>よろしくお願いします。
|
|
VBA初心者
- 10/4/5(月) 13:01 -
![[未読]](./data/access/image/read_icon.gif){kind=icon}
