| |
いつもお世話になります。
ご回答有難うございます。
>とりあえず、ORDER BY句が２つ存在しているので、エイリアスの無い方を消してください。
削除して修正しました。
>前回の発言の２は修正されましたか？
>おそらく、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句が２つ存在しているので、エイリアスの無い方を消してください。
>「３を指定してください」の意味は、３カ所、解析できない＝不明の文字列が存在するという意味です。
>ORDER BYの不備を直せば、残り２カ所です。
>
>あとはプログラムを見る限り、strWhere変数にセットされている値が問題だと思うのですが。
>前回の発言の２は修正されましたか？
>おそらく、strWhere変数にも 「カラム名＝値」形式の文字列がセットされていると思うのですが、
>そこを、「エイリアス．カラム名＝値」書き換える必要があります。
>
>あと確認するとすれば、Me.RecordSourceにセットされているSQLに、A〜K、コメントというカラムがSELECTされているかどうかを確認するくらいでしょうか
▼247b さん：
>とりあえず、ORDER BY句が２つ存在しているので、エイリアスの無い方を消してください。
>「３を指定してください」の意味は、３カ所、解析できない＝不明の文字列が存在するという意味です。
>ORDER BYの不備を直せば、残り２カ所です。
>
>あとはプログラムを見る限り、strWhere変数にセットされている値が問題だと思うのですが。
>前回の発言の２は修正されましたか？
>おそらく、strWhere変数にも 「カラム名＝値」形式の文字列がセットされていると思うのですが、
>そこを、「エイリアス．カラム名＝値」書き換える必要があります。
>
>あと確認するとすれば、Me.RecordSourceにセットされているSQLに、A〜K、コメントというカラムがSELECTされているかどうかを確認するくらいでしょうか。
|
|
VBA初心者
- 10/4/5(月) 16:44 -
![[未読]](./data/access/image/read_icon.gif){kind=icon}
