[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『クエリのVBAについて』（りぃ）
お知恵を拝借させていただければ幸いです。
GetOpenFileでcsvを選択し、そのcsvをクエリに取り込み色々加工してから吐き出すVBAを作成しています。
やりたいこととして、このマクロを実行するシート名に合わせてクエリの名前を変えたいです。
ActiveSheetの名前を変数"a"に取得し、その変数をクエリの名前の部分と置換してみたところ、
「クエリ"a"が見つかりませんでした」というエラーが出てしまいます。
※変数aを固定の名称の場合は正常に動くことを確認済みです
以下が置換した後のソースとなります。
Dim a As String
a = wks.name
Set qry = wkb.Queries.Item(a)
qry.Delete
'クエリの生成
Set qry = wkb.Queries.Add(a, form)
'シートへの書き出し
With wks.ListObjects.Add(SourceType:=0, Source:= _
"OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=a;Extended Properties=""""" _
, Destination:=Range("$A$1")).QueryTable
.CommandType = xlCmdSql
.CommandText = Array("SELECT * FROM [a]")
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.ListObject.DisplayName = a
.refresh BackgroundQuery:=False
End With
この時、クエリの生成は出来ているため
シートでの書き出しのどこかで詰まっているのだとは思いますがどこが原因かわかりません。
何が原因か教えていただけますと幸いです。
よろしくお願いいたします。
＜ 使用 Excel：Excel2016、使用 OS：Windows10 ＞
全体を見ていないですが、
Set qry = Nothing
On Error Resume Next
Set qry = wkb.Queries.Item(a)
On Error Goto 0
If Not qry Is Nothing Then qry.Delete
としても変わらないでしょうか。 （QS） 2020/10/06(火) 18:52
こんばんは！ 試しに↓これをコメントにして .ListObject.DisplayName = a
そのシートモジュールに↓としてみてはどうでしょうか？ Option Explicit Sub mm() Dim Qu As Object For Each Qu In Me.ListObjects Debug.Print Qu.Name Next End Sub （SoulMan） 2020/10/06(火) 20:37
クエリが存在しない状態のケアは確かにしていませんでしたので助かりました。
ありがとうございます。
ただ、元々クエリの生成まではできているためご提示の部分はクリアできています。
With～End Withのどこかで詰まっているものと思っております。
SoulManさん
ListObectsに対して、メソッドまたはデータメンバが見つかりません。
のエラーがでます。
Meキーワードというものを初めて知ったため
後学のためにどのような処理をしようとしていたのか教えていただけると幸いです。
（りぃ） 2020/10/07(水) 13:03
こんばんは！ あっ、そうなんですね。。。 ということはそのシートのテーブルがないんですね？？？？ 私も最近全くやってないので自分のPCを検索したら↓こんなコードが出てきました。。。 動くかどうかわかりませんが、、、SqlとPathを変更して何かの参考になりませんでしょうか？？？？
Option Explicit
Public MyFlag As Boolean
Dim MyClassQueryTable As New Class1
Sub RunQTEvent()
MyClassQueryTable.MyQueryEvent QT:=ActiveSheet.QueryTables(1)
End Sub
Sub Macro1()
Dim MyQtName As String
Dim MyQt As QueryTable
Dim MyName As String
Dim MyBook As String
Dim MyDest As Range
Dim nn As Name
Dim x As Long
For Each MyQt In ActiveSheet.QueryTables
MyQt.Delete
Next
For Each nn In ThisWorkbook.Names
nn.Delete
Next
ActiveSheet.Cells.ClearContents
MyBook = ThisWorkbook.Path
MyBook = MyBook & "\" & "Data.xls"
Set MyDest = ActiveSheet.Range("A1")
MyFlag = False
On Error Resume Next
ActiveSheet.QueryTables.Item(1).Refresh
On Error GoTo 0
If MyFlag = False Then
With ActiveSheet.QueryTables.Add("ODBC;DSN=Excel Files;DBQ=" & MyBook, MyDest)
.Sql = "SELECT * FROM `T_住所$` WHERE (名前 Not Like '%高嶋%')"
.Name = "MyQuery"
.Refresh
End With
MsgBox ActiveSheet.QueryTables.Item(1).Name
RunQTEvent
End If
End Sub
クラスモジュールに↓
Option Explicit
Public WithEvents MyQueryTable As QueryTable
Sub MyQueryEvent(QT As Object)
Set MyQueryTable = QT
End Sub
Private Sub MyQueryTable_BeforeRefresh(Cancel As Boolean)
MyFlag = True
End Sub
（SoulMan） 2020/10/07(水) 19:28
>Meキーワードというものを初めて知ったため シートモジュールにMeと書くとそれはその言葉のごとくシートです。
Meと打って . ドットを打つとそのメンバーが表示されます。
ThisWorkBookモジュールにMeと打つとそれは、Bookです。 要は、オブジェクトでMeとは自分自身のことです。。。
多分、、お分かりの上で質問されてるのでしょうけど。。。 まぁ、、ごくごく普通のことですよね？？？？？
>※変数aを固定の名称の場合は正常に動くことを確認済みです なのでテーブルはあるとして、、名前はExcelが勝手につけますから。。。 どんな名前になっているか調べてみてはどうでしょうか？ と思った次第です。。。 でも、、見当違いだったみたいですね。。。失礼しました。。。
ちなみに上のコードは2005年に書いたものでした。。。 （SoulMan） 2020/10/07(水) 19:38
＞シートモジュールにMeと書くとそれはその言葉のごとくシートです。 なるほど…検索をかけたのですがいまいち飲み込めていなかったのでありがたいです。 ちなみに本当に理解していませんでした…申し訳ありません。
＞ということはそのシートのテーブルがないんですね？？？？ 正確に言うとテーブルの生成までは出来ているようです。 シート状に「Sheet1」という名前のテーブルは出来ていて、そこの見出し行に "ExternalData_1 : データの取り出し中..." と書かれている状態になります。
この時、クエリの名前も当然「sheet1」なのですが、VBAでのエラーが 「クエリ"a"が見つかりませんでした」ということを考えると "a"が変数でなく名前として受け渡されてしまっている気もしてきました。
＞私も最近全くやってないので自分のPCを検索したら↓こんなコードが出てきました。。。 ありがとうございます。 VBAの知識がまばらにしかないのでゆっくりですが読み解きたいと思います。 （りぃ） 2020/10/08(木) 11:08
こんばんは！
>"a"が変数でなく名前として受け渡されてしまっている気もしてきました。 それは、ブレイクポイントを設定するとかDebug.Printで書き出すとかすればいいでしょう。
注意しなければいけないことはその名前が既に使われている可能性があるということです。 15年前に書いた私のコードでも一度全ての名前を削除しています。
つまり↓この部分は使われていない名前ならば登録できると思います。 >.ListObject.DisplayName = a なので何が目的なのかわかりませんが、、名前はExcelに任せてコメントにしてもコードは走ると思います。 後で名前を取得すればいいでしょう。
どうしても名前をコントロールしたいときはその名前がないことを確認してから代入してみてはどうでしょうか？ （SoulMan） 2020/10/08(木) 20:45
横から失礼します。
.CommandText = Array("SELECT * FROM [a]")
ここのaがおかしくないですか？
変数ではなく文字列になっています。
もし関係なければスルーしてください。 （めいぷる） 2020/10/09(金) 11:54
めいぷる さん ありがとうございます。 ほんとですね。。 多分、そうですね。。。 （SoulMan） 2020/10/09(金) 13:27
めいぷるさん 恐らくそこですね。ありがとうございます。 私の理解不足の結果の見落としです。 テーブル名を受け渡せるように修正したいと思います。
soulManさん 色々とご協力・考察してくださりありがとうございました。 一応シート内とクエリは全てクリアするようにしておりましたが、 今後作業で詰まった場合はその観点にも着目したいと思います。
今回質問させていただき、今までやりたい作業をするためだけにVBAを触っていたツケを感じました。 基本を勉強していなく、ご迷惑をおかけしました。精進していきます。 （りぃ） 2020/10/09(金) 14:18
お世話になっております。 皆様のおかげで無事に希望の動作を行うことができました。 大変感謝しております。 もし同様の処理を行いたい方がいたら何かの参考になればと思い、最終ソースを貼らせていただきます。 （ソースの記述にお見苦しい点があるとは思いますがご容赦ください）
Option Explicit
'変数宣言 Dim form As String Dim qry As WorkbookQuery Dim wkb As Workbook Dim wks As Worksheet
Sub 取り込み()
Dim Pa As String
Dim sheetname As String
'再計算停止
Application.Calculation = xlCalculationManual
'描画停止
Application.ScreenUpdating = False
Set wkb = ActiveWorkbook
Set wks = ActiveSheet
ChDir ThisWorkbook.Path
'ファイル選択
Pa = Application.GetOpenFilename(",*.csv")
If Pa <> "False" Then
'加工条件を指定
form = "let" & _
" ソース = Csv.Document(File.Contents(""" & Pa & """),[Delimiter="","", Columns=6, Encoding=932, QuoteStyle=QuoteStyle.None])," & _
" フィルターされた行 = Table.SelectRows(ソース, each ([Column6] <> """"))," & _
" 昇格されたヘッダー数 = Table.PromoteHeaders(フィルターされた行, [PromoteAllScalars=true])," & _
" フィルターされた行1 = Table.SelectRows(昇格されたヘッダー数, each ([#""比較結果(簡易)""] <> ""スキップされたファイル""))," & _
" 追加された条件列 = Table.AddColumn(フィルターされた行1, ""カスタム"", each if [拡張子] = ""h"" then ""ヘッダー"" else if [拡張子] = ""nfc"" then ""ファイル名(コメント・定義部)"" else if [拡張子] = ""s"" then ""アセンブラ"" else ""関数"")," & _
" 削除された列 = Table.RemoveColumns(追加された条件列,{""左更新日時"", ""右更新日時"", ""拡張子""})," & _
" 並べ替えられた列 = Table.ReorderColumns(削除された列,{""フォルダー"", ""名前"", ""カスタム"", ""比較結果(簡易)""})," & _
" 名前が変更された列 = Table.RenameColumns(並べ替えられた列,{{""カスタム"", ""分類""}})," & _
" フィルターされた行2 = Table.SelectRows(#""名前が変更された列"", each ([フォルダー] <> """"))," & _
" フィルターされた行3 = Table.SelectRows(フィルターされた行2, each not Text.Contains([フォルダー], ""Tool""))" & _
"in" & " フィルターされた行3" & ""
'ワークシートをクリア
wks.Cells.Clear
Call csv取り込み(form, wkb, wks)
MsgBox (" ＊取得完了しました＊")
Else
End If
'計算再開
Application.Calculation = xlCalculationAutomatic
'描画再開
Application.ScreenUpdating = True
End Sub
Sub csv取り込み(form As String, wkb As Workbook, wks As Worksheet)
Dim wksname As String
Dim con As WorkbookConnection
wksname = wks.name
'同名クエリ削除
Set qry = Nothing
On Error Resume Next
Set qry = wkb.Queries.Item(wksname)
On Error GoTo 0
If Not qry Is Nothing Then qry.Delete
'クエリの生成
Set qry = wkb.Queries.Add(wksname, form)
'シートへの書き出し
With wks.ListObjects.Add(SourceType:=0, _
Source:="OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=" & wksname & ";Extended Properties=""""", _
Destination:=Range("$A$1")).QueryTable
.AdjustColumnWidth = True
.BackgroundQuery = True
.CommandText = "SELECT * FROM" & " [" & wksname & "]"
.RefreshStyle = xlInsertDeleteCells
.RefreshPeriod = 0
.ListObject.DisplayName = wksname
.refresh BackgroundQuery:=False
End With
'接続全削除
For Each con In wkb.Connections
con.Delete
Next
End Sub
（りぃ） 2020/10/12(月) 17:11
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.