★ExcelVBA ~ パワークエリのかわり~ SQLとODBCで、ブック内の全シートを「列名指定だけで」、縦に結合するプログラム。列さえあればその並び順は左右ぐちゃぐちゃでもOK！！（もしどこかのシートに「足らない列」があった場合は、その列を「データ無し」で自動追加しながら。） | 無駄なお金と時間がない方・零細企業様・独立したい方・個人事業主の方・営業さん・経理さん・学生さん・就活生さん・小学生のお子様、中高生の子たちのための、　　　　「小さな会社の兼任なんちゃって社内SE・パソコン管理術・の基礎知識」

★ExcelVBA ~ パワークエリのかわり~ SQLとODBCで、ブック内の全シートを「列名指定だけで」、縦に結合するプログラム。列さえあればその並び順は左右ぐちゃぐちゃでもOK！！（もしどこかのシートに「足らない列」があった場合は、その列を「データ無し」で自動追加しながら。）
　　
※まだ書きかけです。すみません。
※間違ってたらすみません。
※メモ書きなので、自分でも意味不明な箇所も多いです。ごめんなさい。

ブック内の全シートを「列名指定だけで」、縦に結合するプログラムです。

各シート内に不足列があれば自動的に（データ無しの）列が追加されますし、
全シート、同じ名前の列さえあれば、「各シート内でのその列の並び順」は、
左右ぐちゃぐちゃでもOKです！！

パワークエリだと
「このレベルですら」
「M言語を学習しないと無理」で、
「意外と簡単に」
「VBA以上に」
「属人化する」ので、
かえってVBAのほうが「土台を作るのは面倒かも」しれませんが、そのあとの作り替えや「操作自体」は、VBAのほうが簡単かもしれません。

空白のシートをつくったのち、「全シートで統一したい、そういう列名」を指定してF5キー押すだけですから。パワークエリのようにいくつもステップ作ったり、などの面倒な操作は全くありません。

以降の２つのモジュールを標準モジュールを適当に2つ作ってコピペし、
１つ目のモジュールの「test04()」関数を、
「統一したい列名」の設定部分だけ目的に合うように書き変えたのち、
空白のシートを作ってからそれを表示した状態で、F5キーを押すことで実行するだけです。

QuetyTableのあるシートを初期化するには、
１つ目のモジュールの「QTDell04」関数を使ってください。
じゃないと名前定義でひっかかって中断されてしまいますので・・・。

１つ目のモジュールの「test04()」関数の書き換え部分は、
「'以下、すべてのシートにて、足らないフィールド名の追記」の部分と、
「'以下、すべてのシートを通してのSQLの生成」の部分の２か所です。
いずれも「For Each」のループの中です。

そこのコメントに書いてあるように修正します。
基本、その２箇所で、同じ列名を指定すればOKです。

モジュールのコピペさえしてしまえば、
単純なものであれば、パワークエリでやるよりは簡単かと思います。

なお、各シートでレコードが追加されたら、QuetyTableのシートで右クリックして「更新」すれば、その内容が反映されます。

少し書き変えれば、パワークエリでやりたいような、
「列構成が違うシートを無理矢理縦結合する」
「すべてのサブフォルダの、すべてのファイルの指定したシートだけの列構成が違うシートを無理矢理縦結合する」
「それの指定したファイルだけをやる」
みたいなこともできると思います。

★１つ目のモジュール

'
'
Option Explicit


'###############################################################################
'このシート専用のQueryTableオブジェクトの削除（名前の定義も一緒に消えます。）
'###############################################################################
Sub QTDell04()
'    Call QTDelFunc01(Worksheets("Sheet4"))
    Call QTDelFunc01(ActiveSheet)
End Sub
 
 
'###############################################################################
'
'★空のシートが無いことが前提。あるとエラーになる。
'★各シート、A1セルから右に、１行目に列名が始まっていることが前提。
'
'QueryTableオブジェクトを自動作成するプログラムの一例
'自ファイルにて、アクティブシート以外のすべてのシートを、
'足らない列名を追記しつつ、SQLを使って縦に結合する。
'
'「列名の並び順」は各シートで違っててもいい。データ型さえ合っていれば。
'足らない列があるシートには、データ無しとして、その列名を自動追記する。
'
'パワークエリだと面倒なので、VBAでやってみた。
'VBAでも面倒だけど、形だけ作ってしまえば、通常は列名の指定だけで済む。
'その意味ではパワークエリよりも簡単かも。
'###############################################################################

Sub test04()

    '空白のシートが無い、列名の行が全シート同じ（できれば1行目）、先頭列がA列、
    'であることが前提です。じゃないとエラーになります。
    '列名の行が１行目じゃないゆえにエラーが出る場合は、
    '列名の上の空白行などをカットするコードを追加してください。
       

    Dim s_TrgFNm001jj       As String      '外部の、吸い込みたい先のファイル
    Dim s_TrgFoldPath001jj  As String      'そのファイルが在るフォルダ
    Dim s_FpathLen          As Integer
    Dim s_SqlStr01jj        As String      '吸い込むときのSQL内容
    Dim s_ChkQTobjNm01jj    As String      '付けたい、「QueryTableオブジェクトの名前」
    Dim o_ImpSht001jj       As Worksheet   'このファイルの中の、QTオブジェクトを生成したいシート（オブジェクト）
    Dim s_ImpCelAddr001jj   As String      'そのシートのQTオブジェクトを生成したいセル位置


    'チェック01
    If 2 <= ActiveSheet.UsedRange.Cells.Count Then
    
        MsgBox "空白シートをアクティブにするか、今のシートを空白に初期化してから再操作してください"
        '（じゃないとエラーになるので。理由はめんどくさくて未調査。）
        
        Exit Sub
    Else
    
    End If
    
    
    
    '★設定部
    
    '他ファイルデータの吸込み用設定
    s_TrgFNm001jj = ThisWorkbook.FullName       '自ファイルのフルパス
    s_TrgFoldPath001jj = ThisWorkbook.Path
    Set o_ImpSht001jj = ActiveSheet     'このファイルの中の、QTオブジェクトを生成したいシート（オブジェクト）
    s_ImpCelAddr001jj = "$A$1"                  'そのシートのQTオブジェクトを生成したい起点セルの位置

       
    o_ImpSht001jj.Activate
    o_ImpSht001jj.Range("A1").Select
    
        
    s_ChkQTobjNm01jj = "QTSht0２２_Imp_"
       '「重複を調べたい＝付けたい」
       '「QueryTableオブジェクトの名前」の設定
        
    
    '========================================================
    '以下、すべてのシートにて、足らないフィールド名の追記
    '（アクティブシート以外）
    '「Call AddNewFld01(o_ItemWs01, "大分類", s_StrtCellAddr01)」のような形で指定。
    '全シートで統一させたい列名の数だけ、書く。
    '既存の列名には記述ミスが無いことが前提｡
    '列名が２０列や３０列を超えるようなら、ループで列名を構築するコードに変えたほうが良いかも。
    

    Dim s_StrtCellAddr01    As String
    Dim o_ItemWs01          As Worksheet
    
    Let s_StrtCellAddr01 = "A1"
    '列名のセルの起点のセルを指定。
    '全シート同じ行に列名が無いといけない。
    'あるいは、事前に１行目が列名の行になるように、手動かVBAで整形しておく。
   

    For Each o_ItemWs01 In Worksheets
    
        If ActiveSheet.Name = o_ItemWs01.Name Then
            'アクティブシートはQuetyTableを出力するので
            '何もしてはいけない。スルー。
        Else
            'それ以外のシートは、足らない列名を追記する。
            
'            Debug.Print o_ItemWs01.Name

            Call AddNewFld01(o_ItemWs01, "大分類", s_StrtCellAddr01)
            Call AddNewFld01(o_ItemWs01, "中分類", s_StrtCellAddr01)
            Call AddNewFld01(o_ItemWs01, "小分類", s_StrtCellAddr01)
            Call AddNewFld01(o_ItemWs01, "小々分類", s_StrtCellAddr01)
            
        End If
    
    Next o_ItemWs01
    'すべてのシートにおいて、不足する列名を追記するループ。
    '（空白シート＝アクティブシート＝QueryTable出力先シート）


    'SQL文の設定（古いのでコメントアウトした）
'    s_SqlStr01jj = "SELECT * FROM `sheet1$`"

    '========================================================
    '以下、すべてのシートを通してのSQLの生成
    '（アクティブシート以外）
    'SQL文を255文字ずつの配列にする。
    'なので、最後の「MSQryOnlMakeByODBCFunc001」関数のSQL文の型も、配列（Variant型）に変更した。

    '「", 大分類" & _」のような形で指定。
    '全シートで統一させたい列名の数だけ、書く。
    '既存の列名には記述ミスが無いことが前提｡
    '列名が２０列や３０列を超えるようなら、ループで列名を構築するコードに変えたほうが良いかも。

'    Stop
    
    Dim o_ItemWs02      As Worksheet
'    Dim Ary_s_SQL01      As Variant 'Split使うならこっちの書き方だけど、使うのやめたのでコメントアウト。
    Dim Ary_s_SQL01()   As Variant

    
    For Each o_ItemWs02 In Worksheets
    
        If ActiveSheet.Name = o_ItemWs02.Name Then
            'アクティブシートはSQL対象ではないので
            '何もしないでスルー
        Else
            'アクティブシート以外はSQL操作対象
            s_SqlStr01jj = s_SqlStr01jj & _
                           "SELECT " & _
                           " '" & o_ItemWs02.Name & "' AS シート名" & _
                           ", 大分類" & _
                           ", 中分類" & _
                           ", 小分類" & _
                           ", 小々分類" & _
                           " FROM  [" & o_ItemWs02.Name & "$]" & _
                           " UNION ALL "
                           
        End If
        
    Next o_ItemWs02
    '全シート縦結合のSQL文を生成するループ
    
    
    s_SqlStr01jj = Left(s_SqlStr01jj, Len(s_SqlStr01jj) - 11)
    'SQL文の末尾の余計な「UNION ALL」を消す。
    
'    Debug.Print s_SqlStr01jj
    
'    Ary_s_SQL01 = Split(s_SqlStr01jj, "$]")
     'Splitを使うと、デリミタの文字が消されてしまうのでやめて、
     '一定の文字数（255文字）で区切って、１次元配列に入れることにした。


    Ary_s_SQL01 = SQLCmdAryMake01(s_SqlStr01jj, 255)
    'SQLコマンドを２５５文字ずつで区切って配列化。
    '（※SQL文全体が２５５文字を超えるとエラーになるし、
    '    もともとSQLコマンドの引数の型自体が、Variant型の配列だから。）

 
        '※テーブル名は上記のように「`」で囲むのもOKですし、
        '  「角カッコ」で囲むのもOKです。
        '   角カッコで囲むと『 [Sheet1$] 』となります。
        '   フィールド名に別名を付けたときは、別名に角カッコを使うほうが
        '   結果の表のフィールド名に「’」が付かないので便利かもしれません。
    

        
    '★ チェック部
    
    '指定したブック内に、指定した名前を含むQueryTableオブジェクトが
    '既に存在していないかどうかをチェック。
    '在ったら中断。
    If QTSonzaiChk01(ThisWorkbook, s_ChkQTobjNm01jj) = 1 Then
        Exit Sub
    Else
    
    End If
    
'    Stop
 
 
    '★ 実動部
    
    'SQLの実行＝SQLでの吸込み

'以下、古いコードなのでコメントアウト。使わない。
'    Call MSQryOnlMakeByODBCFunc001(s_TrgFNm001jj, _
'                                   s_TrgFoldPath001jj, _
'                                   s_SqlStr01jj, _
'                                   s_ChkQTobjNm01jj, _
'                                   o_ImpSht001jj, _
'                                   s_ImpCelAddr001jj)

    Call MSQryOnlMakeByODBCFunc001(s_TrgFNm001jj, _
                                   s_TrgFoldPath001jj, _
                                   Ary_s_SQL01, _
                                   s_ChkQTobjNm01jj, _
                                   o_ImpSht001jj, _
                                   s_ImpCelAddr001jj)
' 呼び出し方法
'    Call MSQryOnlMakeByODBCFunc001("読みに行きたいファイルのフルパス",
'                                   "そのファイルの在るフォルダのパス",
'                                   SQL文,
'                                   結果表（QueryTableオブジェクト）につけたい名前,
'                                   結果を出力したい「オブジェクトとしての」シート.
'                                   結果表を出力するセルのアドレス（表の一番左上隅のセルの。)
'


End Sub

'
'

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

191

192

193

194

195

196

197

198

199

200

201

202

203

204

205

206

207

208

209

210

211

212

213

214

215

216

217

218

219

220

221

222

223

224

225

226

227

228

229

230

231

232

233

Option Explicit

'###############################################################################

'このシート専用のQueryTableオブジェクトの削除（名前の定義も一緒に消えます。）

'###############################################################################

Sub QTDell04()

' Call QTDelFunc01(Worksheets("Sheet4"))

Call QTDelFunc01(ActiveSheet)

End Sub

'###############################################################################

'★空のシートが無いことが前提。あるとエラーになる。

'★各シート、A1セルから右に、１行目に列名が始まっていることが前提。

'QueryTableオブジェクトを自動作成するプログラムの一例

'自ファイルにて、アクティブシート以外のすべてのシートを、

'足らない列名を追記しつつ、SQLを使って縦に結合する。

'「列名の並び順」は各シートで違っててもいい。データ型さえ合っていれば。

'足らない列があるシートには、データ無しとして、その列名を自動追記する。

'パワークエリだと面倒なので、VBAでやってみた。

'VBAでも面倒だけど、形だけ作ってしまえば、通常は列名の指定だけで済む。

'その意味ではパワークエリよりも簡単かも。

'###############################################################################

Sub test04()

'空白のシートが無い、列名の行が全シート同じ（できれば1行目）、先頭列がA列、

'であることが前提です。じゃないとエラーになります。

'列名の行が１行目じゃないゆえにエラーが出る場合は、

'列名の上の空白行などをカットするコードを追加してください。

Dim s_TrgFNm001jj As String '外部の、吸い込みたい先のファイル

Dim s_TrgFoldPath001jj As String 'そのファイルが在るフォルダ

Dim s_FpathLen As Integer

Dim s_SqlStr01jj As String '吸い込むときのSQL内容

Dim s_ChkQTobjNm01jj As String '付けたい、「QueryTableオブジェクトの名前」

Dim o_ImpSht001jj As Worksheet 'このファイルの中の、QTオブジェクトを生成したいシート（オブジェクト）

Dim s_ImpCelAddr001jj As String 'そのシートのQTオブジェクトを生成したいセル位置

'チェック01

If 2 <= ActiveSheet.UsedRange.Cells.Count Then

MsgBox "空白シートをアクティブにするか、今のシートを空白に初期化してから再操作してください"

'（じゃないとエラーになるので。理由はめんどくさくて未調査。）

Exit Sub

Else

End If

'★設定部

'他ファイルデータの吸込み用設定

s_TrgFNm001jj = ThisWorkbook.FullName '自ファイルのフルパス

s_TrgFoldPath001jj = ThisWorkbook.Path

Set o_ImpSht001jj = ActiveSheet 'このファイルの中の、QTオブジェクトを生成したいシート（オブジェクト）

s_ImpCelAddr001jj = "$A$1" 'そのシートのQTオブジェクトを生成したい起点セルの位置

o_ImpSht001jj.Activate

o_ImpSht001jj.Range("A1").Select

s_ChkQTobjNm01jj = "QTSht0２２_Imp_"

'「重複を調べたい＝付けたい」

'「QueryTableオブジェクトの名前」の設定

'========================================================

'以下、すべてのシートにて、足らないフィールド名の追記

'（アクティブシート以外）

'「Call AddNewFld01(o_ItemWs01, "大分類", s_StrtCellAddr01)」のような形で指定。

'全シートで統一させたい列名の数だけ、書く。

'既存の列名には記述ミスが無いことが前提｡

'列名が２０列や３０列を超えるようなら、ループで列名を構築するコードに変えたほうが良いかも。

Dim s_StrtCellAddr01 As String

Dim o_ItemWs01 As Worksheet

Let s_StrtCellAddr01 = "A1"

'列名のセルの起点のセルを指定。

'全シート同じ行に列名が無いといけない。

'あるいは、事前に１行目が列名の行になるように、手動かVBAで整形しておく。

For Each o_ItemWs01 In Worksheets

If ActiveSheet.Name = o_ItemWs01.Name Then

'アクティブシートはQuetyTableを出力するので

'何もしてはいけない。スルー。

Else

'それ以外のシートは、足らない列名を追記する。

' Debug.Print o_ItemWs01.Name

Call AddNewFld01(o_ItemWs01, "大分類", s_StrtCellAddr01)

Call AddNewFld01(o_ItemWs01, "中分類", s_StrtCellAddr01)

Call AddNewFld01(o_ItemWs01, "小分類", s_StrtCellAddr01)

Call AddNewFld01(o_ItemWs01, "小々分類", s_StrtCellAddr01)

End If

Next o_ItemWs01

'すべてのシートにおいて、不足する列名を追記するループ。

'（空白シート＝アクティブシート＝QueryTable出力先シート）

'SQL文の設定（古いのでコメントアウトした）

' s_SqlStr01jj = "SELECT * FROM `sheet1$`"

'========================================================

'以下、すべてのシートを通してのSQLの生成

'（アクティブシート以外）

'SQL文を255文字ずつの配列にする。

'なので、最後の「MSQryOnlMakeByODBCFunc001」関数のSQL文の型も、配列（Variant型）に変更した。

'「", 大分類" & _」のような形で指定。

'全シートで統一させたい列名の数だけ、書く。

'既存の列名には記述ミスが無いことが前提｡

'列名が２０列や３０列を超えるようなら、ループで列名を構築するコードに変えたほうが良いかも。

' Stop

Dim o_ItemWs02 As Worksheet

' Dim Ary_s_SQL01 As Variant 'Split使うならこっちの書き方だけど、使うのやめたのでコメントアウト。

Dim Ary_s_SQL01() As Variant

For Each o_ItemWs02 In Worksheets

If ActiveSheet.Name = o_ItemWs02.Name Then

'アクティブシートはSQL対象ではないので

'何もしないでスルー

Else

'アクティブシート以外はSQL操作対象

s_SqlStr01jj = s_SqlStr01jj & _

"SELECT " & _

" '" & o_ItemWs02.Name & "' AS シート名" & _

", 大分類" & _

", 中分類" & _

", 小分類" & _

", 小々分類" & _

" FROM [" & o_ItemWs02.Name & "$]" & _

" UNION ALL "

End If

Next o_ItemWs02

'全シート縦結合のSQL文を生成するループ

s_SqlStr01jj = Left(s_SqlStr01jj, Len(s_SqlStr01jj) - 11)

'SQL文の末尾の余計な「UNION ALL」を消す。

' Debug.Print s_SqlStr01jj

' Ary_s_SQL01 = Split(s_SqlStr01jj, "$]")

'Splitを使うと、デリミタの文字が消されてしまうのでやめて、

'一定の文字数（255文字）で区切って、１次元配列に入れることにした。

Ary_s_SQL01 = SQLCmdAryMake01(s_SqlStr01jj, 255)

'SQLコマンドを２５５文字ずつで区切って配列化。

'（※SQL文全体が２５５文字を超えるとエラーになるし、

' もともとSQLコマンドの引数の型自体が、Variant型の配列だから。）

'※テーブル名は上記のように「`」で囲むのもOKですし、

' 「角カッコ」で囲むのもOKです。

' 角カッコで囲むと『 [Sheet1$] 』となります。

' フィールド名に別名を付けたときは、別名に角カッコを使うほうが

' 結果の表のフィールド名に「’」が付かないので便利かもしれません。

'★ チェック部

'指定したブック内に、指定した名前を含むQueryTableオブジェクトが

'既に存在していないかどうかをチェック。

'在ったら中断。

If QTSonzaiChk01(ThisWorkbook, s_ChkQTobjNm01jj) = 1 Then

Exit Sub

Else

End If

' Stop

'★ 実動部

'SQLの実行＝SQLでの吸込み

'以下、古いコードなのでコメントアウト。使わない。

' Call MSQryOnlMakeByODBCFunc001(s_TrgFNm001jj, _

' s_TrgFoldPath001jj, _

' s_SqlStr01jj, _

' s_ChkQTobjNm01jj, _

' o_ImpSht001jj, _

' s_ImpCelAddr001jj)

Call MSQryOnlMakeByODBCFunc001(s_TrgFNm001jj, _

s_TrgFoldPath001jj, _

Ary_s_SQL01, _

s_ChkQTobjNm01jj, _

o_ImpSht001jj, _

s_ImpCelAddr001jj)

' 呼び出し方法

' Call MSQryOnlMakeByODBCFunc001("読みに行きたいファイルのフルパス",

' "そのファイルの在るフォルダのパス",

' SQL文,

' 結果表（QueryTableオブジェクト）につけたい名前,

' 結果を出力したい「オブジェクトとしての」シート.

' 結果表を出力するセルのアドレス（表の一番左上隅のセルの。)

End Sub

★２つ目のモジュール

'
'
Option Explicit


'###############################################################################
'SQLコマンドの配列（Variant型）を、文字数区切りで生成する関数
'SQL以外にも文字列を文字数区切りで配列化したいときにも使えます。
'
' Call SQLCmdAryMake01(区切りたい文字列 , 区切る文字数)
'
'###############################################################################

Function SQLCmdAryMake01(ByVal s_SqlStr01jj As String, ByVal i_SplitNum01 As Integer) As Variant

'    Dim s_SqlStr01jj    As String
'    Dim i_SplitNum01    As Integer 'SQLコマンドの配列に格納するのに、何文字ごとにSplitするかの文字数

    Dim Ary_s_SQL01()   As Variant
    Dim i_Cnt01         As Integer
    Dim s_Chunk         As String  'Chunk＝かたまり
    Dim i_ChunkNum01    As Integer 'i_ChunkNum01＝255文字ごとのかたまりの数（→つまり、要素数になる）


'    s_SqlStr01jj = "galgkjaldsgjalsjga"

'    i_SplitNum01 = 5
    'SQLコマンドの配列の各要素に格納する文字数の設定。256文字以上はダメだった 。
    
    i_ChunkNum01 = Len(s_SqlStr01jj) \ i_SplitNum01 + IIf(Len(s_SqlStr01jj) Mod i_SplitNum01 > 0, 1, 0)
    'SQLを255文字のかたまりにすると、いくつの要素数になるかの計算。
    
'    Stop
 
    ReDim Ary_s_SQL01(0 To i_ChunkNum01 - 1)
    '空の配列を生成。
    
    For i_Cnt01 = 0 To (i_ChunkNum01 - 1)
        s_Chunk = Mid(s_SqlStr01jj, i_Cnt01 * i_SplitNum01 + 1, i_SplitNum01)
        Ary_s_SQL01(i_Cnt01) = s_Chunk
    Next i_Cnt01
    ' 255文字ずつ取り出して配列に格納するループ。
    
    SQLCmdAryMake01 = Ary_s_SQL01
    

End Function


'###############################################################################
'指定したシートにて、足らない列名を足すための関数
'###############################################################################

Sub AddNewFld01(o_Ws001 As Worksheet, s_SrchWrd As String, s_StrtCellAdr)

'    Dim o_TrgWs001 As Worksheet
    Dim o_SearchRange As Range
    Dim o_foundCell As Range
    Dim l_lastCol As Long
    Dim l_CrntRow As Long


'    Set o_TrgWs001 = o_Ws001
    ' ターゲットのシートを設定

    l_lastCol = o_Ws001.Range(s_StrtCellAdr).End(xlToRight).Column
    'スタートセルの行の右端のセルの列名（R1C1形式の数字）を取得。

    l_CrntRow = o_Ws001.Range(s_StrtCellAdr).Row

    Set o_SearchRange = o_Ws001.Range(o_Ws001.Range(s_StrtCellAdr).Address, Cells(l_CrntRow, l_lastCol).Address)
    'スタートセルの行（列名の入った列）のセル範囲を設定

    Set o_foundCell = o_SearchRange.Find(What:=s_SrchWrd, LookAt:=xlWhole, MatchCase:=False)
    ' 「検索語句」を検索（Find関数を使用）

    If o_foundCell Is Nothing Then o_Ws001.Cells(l_CrntRow, l_lastCol + 1).Value = s_SrchWrd
    ' 「検索語句」が見つからなかった場合、スタートセルの行の最右列の次のセルに「検索語句」を転記

    Set o_foundCell = o_SearchRange.Find(What:="", LookAt:=xlPart, MatchCase:=False)
    '一応、一般操作画面の検索ダイアログから、今のプロシージャで保存された検索設定を消す。

End Sub

'###############################################################################
'QueryTableオブジェクトの削除（名前の定義も一緒に消えます。）
'###############################################################################

Function QTDelFunc01(o_WSjj As Worksheet)
    
    Dim o_KizonTeigiNm01 As Name
        
    If 1 <= o_WSjj.QueryTables.Count Then
    
        o_WSjj.Activate
        o_WSjj.QueryTables(1).Delete
        o_WSjj.Rows.Delete
          '↑ただの「Cells.ClearContents」だけだと
          '何かが残るみたいで自ファイル参照すると
          'F1、F2、F3・・・みたいになってしまうことがあるので
          '一応、Rows.Deleteにした。でもCells.Deleteのほうがいいのかも？
        o_WSjj.Range("A1").Select
        
    Else
    
    End If
    
    
    'xlsファイル用の名前の定義の削除処理。
    'xlsの場合、QueryTableオブジェクトを削除しても
    '名前の定義が残ってしまうため。
       
'    o_WSjj.Names(o_WSjj.QueryTables(1).Name).Delete

    For Each o_KizonTeigiNm01 In o_WSjj.Names
    
        If 0 < InStr(1, o_KizonTeigiNm01, "", vbBinaryCompare) Then
            o_KizonTeigiNm01.Delete
        Else
        
        End If
        
    Next

        
    'アクティブウィンドウの調整
    ActiveWindow.Zoom = 100           'ズーム 100%
    ActiveWindow.FreezePanes = False  'ウィンドウ枠の解除
    
     
End Function


'###############################################################################
'指定されたブック内に、指定された名前を含むQueryTableオブジェクトが
'存在するかどうかをチェックしたときに、ヒットしたらメッセージを出すだけの、
'（一応状態も数字で返す）関数。
'###############################################################################

Function QTSonzaiChk01(o_WB02jj As Workbook, s_ChkQTobjNm02jj As String) As Integer

    Dim v_Answ01jj          As Variant

    '★ 実動部
    
    '同じ名前か、ほとんど同じ名前（接尾語があるだけの）の、
    'QueryTableオブジェクトが存在するかチェックして
    '在れば中断する分岐。
    'ちなみに、QueryTableオブジェクトが作成されると、
    '名前定義にも勝手に設定が追加されるが、
    'QueryTableオブジェクトをDeleteメソッドで削除すると、その設定も一緒に消えます。
    'ただ、手動でシート上から手作業でQueryTableオブジェクトを削除すると
    '名前定義の設定は残ったままになってしまいます。
    
    v_Answ01jj = KizonQTCheck01(o_WB02jj, s_ChkQTobjNm02jj)
    
    If v_Answ01jj(0) = "OK" Then
    
        QTSonzaiChk01 = 0
        
    ElseIf v_Answ01jj(0) = s_ChkQTobjNm02jj Then
    
        MsgBox "「" & v_Answ01jj(0) & "」を含むQueryTableオブジェクト（＝名前）が、" & _
            vbCrLf & "「" & v_Answ01jj(1) & "」として" & _
            vbCrLf & "「" & v_Answ01jj(2) & "」に見つかりましたので中断します。" & _
            vbCrLf & _
            vbCrLf & "付けたい名前を変更して再度実行してください。"
        
        QTSonzaiChk01 = 1
        Exit Function
    
    End If


End Function


'###############################################################################
'指定されたブック内に、指定された名前を含むQueryTableオブジェクトが
'存在するかどうかをチェックする関数。
'上記関数の「QTSonzaiChk01」から予備だされます。
'なお、戻り値をVariant型の配列にしてあります。
'
'戻り値→（チェックする名前,それを含んだ実際のQTの名前,見つかったシート名）の
'          Variant型の配列。
'
'###############################################################################
 
Function KizonQTCheck01(o_WBjj As Workbook, s_ChkQTNm01jj As String) As Variant

    Dim o_KizonQT01jj   As QueryTable
    Dim o_KizonWSjj     As Worksheet
    Dim i_EscapeForFlg  As Integer
    
    
    
    '★ 設定部
    
    Set o_WBjj = ThisWorkbook
    
    i_EscapeForFlg = 0
    
    
    KizonQTCheck01 = Array("OK", "OK", "OK")
    
        '↑検索がヒットしなかったときの戻り値をあらかじめ設定しておく。
        '  ヒットすれば、この値が別の配列で上書きされる。
        '    ※配列で返したい＋初期値を決めておきたいときは、
        '      あらかじめ配列で初期値を埋めておかないと、
        '　    呼び出し元のプロシージャ側にての、戻り値でのIf文の判断分岐等々にて、
        '     「型が違います」のエラーになるので注意する。
        '      でも、もっとスマートなやり方があるかもしれない。
        
        
    '★ 実動部
    
    
    
    For Each o_KizonWSjj In o_WBjj.Worksheets
      '指定されたQueryTableオブジェクトが存在するかを探すために、
      '全シートを移動するループ。親ループ。
    
'                                             Debug.Print o_KizonWSjj.Name

        If i_EscapeForFlg = 1 Then Exit For
           'もしヒットしたら、この（全部のシートを順に移動していくという）親ループも抜ける。
           '※「i_EscapeForFlg」が１になっていたら、ヒットした、という意味。
        
        
        
        For Each o_KizonQT01jj In o_KizonWSjj.QueryTables
           '各シートの中のすべてのQueryTableオブジェクトを
           'チェックするループ。子ループ。
        
'                                             Debug.Print o_KizonQT01jj.Name
            
            If 1 <= InStr(1, o_KizonQT01jj.Name, _
                          s_ChkQTNm01jj, _
                          vbBinaryCompare) Then
                          
                   '↑目的のQTオブジェクトがヒットした時はこれ以降↓の処理をする。
                   '    目的の名前が含まれたQTオブジェクトがヒットしたとき↓。

'                                             Debug.Print "探しているQueryTableオブジェクトがありました。---" & o_KizonQT01jj.Name
                    
                    
                If Not (o_KizonWSjj Is ActiveSheet) Then
                   'もし、目的の名前のQTオブジェクトが見つかったシートが、
                   'アクティブなシート「以外」であれば、「ヒットした！」と
                   'みなして以下の処理。
                   'アクティブなシートに目的のQTオブジェクトが存在してしまっていたなら、
                   'そのQTは「消しちゃってもいい」ということにして、
                   '「ヒットしなかったもの」とみなす。
                
                    
                    
                    KizonQTCheck01 = Array( _
                                            s_ChkQTNm01jj, _
                                            o_KizonQT01jj.Name, _
                                            o_KizonWSjj.Name)
                                            
                       ' ↑ 戻り値（OK・OK・OK）を、ヒット内容に上書き。
                    
                    
                    i_EscapeForFlg = 1
                       'ヒットしたことを、親ループを抜けるために、メモ。
                    
                    Exit For
                       'この（シート内の全てのQTオブジェクトを調べるという）子ループを抜ける。
                    
                Else
                
                End If
            Else
'                                             Debug.Print "探しているQueryTableオブジェクトはありません。"
            End If
            
        Next
        
        

        
    Next
    


End Function

 
'###############################################################################
'
'「テーブル機能」は使わずに、つまり、QueryTableオブジェクトを埋め込まないパターン。
'そして、他の「XLS、XLSM、XLSX」や自ファイルのシートなどを吸い込む関数のサンプル。
'
'前述の１つ目と同様に、「Microsoft Query」での結合をマクロの記録機能で記録して、<a href="https://euc-access-excel-db.com/tips/ct90_yougo/yougo-sql01" target="_blank" rel="noopener noreferrer">SQL</a>を少し
'短くしただけのコードを、「テーブル機能」に埋め込まないように2行ほど書き換えたもの、を、
'関数化したもの。
'
'これは「QueryTableオブジェクト」のみで結果を表示しています。
'なお、「Microsoft Query」は、実はExcelからは独立した機能ですが、<a href="https://euc-access-excel-db.com/tips/ct90_yougo/yougo-sql01" target="_blank" rel="noopener noreferrer">SQL</a>実行の結果の表は、
'「QeryTableオブジェクト」に返ってくるように、Excel自身が指示を出しているっぽいです。
'なので、「Microsoft Query」と「QueryTableオブジェクト操作」は、機能は操作は異なりますが、
'結果は「QueryTableオブジェクト」に出力される、「同等なもの」と理解して良さそうです。
'
'
' 呼び出し方法
'    Call MSQryOnlMakeByODBCFunc001("読みに行きたいファイルのフルパス",
'                                   "そのファイルの在るフォルダのパス",
'                                   SQL文,
'                                   結果表（QueryTableオブジェクト）につけたい名前,
'                                   結果を出力したい「オブジェクトとしての」シート.
'                                   結果表を出力するセルのアドレス（表の一番左上隅のセルの。)
'
'
'  例：実際には各行に、「 _ 」（半角での、スペース+アンダーバー）が要ります。
'
'    Call MSQryOnlMakeByODBCFunc001("D:\1\クエリのネストのテスト.xls",
'                                   "D:\1",
'                                   s_SqlStr01jj,
'                                   "QT_To_OwnSheet1",
'                                   ActiveSheet,
'                                   "$A$1")
'
'###############################################################################



Sub MSQryOnlMakeByODBCFunc001(s_TrgFNm01jj As String, _
                              s_TrgFPath01jj As String, _
                              s_Sql01jj As Variant, _
                              s_QTNm01jj As String, _
                              o_ImpWSht01jj As Worksheet, _
                              s_ImpRng01jj As String)
   

'On Error GoTo error1:

    Dim o_QT01jj    As QueryTable
    Dim i_Answ01    As Integer

    '★ チェック部

    
    
    '最後のチェック
    i_Answ01 = MsgBox("本当にQueryTableオブジェクトを作成or書き換えてもいいですか？", vbOKCancel)
    
    If i_Answ01 = 2 Then
        Exit Sub  '「いいえ」が押されたら終わる。
    Else
        'それ以外は終わらない。以降の処理を続ける。。
    End If
    
    
    
    '★ 実動部


    'すでにあるQueryTableオブジェクトを処理する
    If 1 <= o_ImpWSht01jj.QueryTables.Count Then
        
        o_ImpWSht01jj.QueryTables(1).Delete
'        o_ImpWSht01jj.Cells.ClearContents
        o_ImpWSht01jj.Rows.Delete
           'いったんQueryTableオブジェクトを削除。
           '紐ついている名前定義も一緒に消去されます。

    Else

    End If
    
    
    'QueryTableオブジェクトの生成
    
    Set o_QT01jj = o_ImpWSht01jj.QueryTables _
                      .Add(Connection:= _
                           "ODBC;DSN=Excel Files" & _
                           ";DBQ=" & s_TrgFNm01jj & _
                           ";DefaultDir=" & s_TrgFPath01jj & _
                           ";DriverId=1046" & _
                           ";MaxBufferSize=2048" & _
                           ";PageTimeout=5" & _
                           ";" _
                           , Destination:=o_ImpWSht01jj.Range(s_ImpRng01jj))
                            
                            
'         Stop
         
    With o_QT01jj
        
'        .CommandText = Array(s_Sql01jj)
        .CommandText = s_Sql01jj
        
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
'        .ListObject.DisplayName = "テーブル_Excel_Files_からのクエリ4"
             '↑この2つ目のサンプルコードは新しいExcelでも もちろん動きますが、
             ' もともとは古いバージョンのExcelのためのものです。
             ' しかしこの行だけは新しいExcelのためのものです。
             ' 古いExcelは、最初から「テーブル機能」が使えないので
             ' 古いExcelでこの2つ目のサンプルを動かすとこの行はエラーになります。
             ' なので、コメントアウトして、代わりに以下の行で名前を設定しています。
        .Name = s_QTNm01jj
        .Refresh BackgroundQuery:=False 'False（同期）でSQLを実行。「同期」だと、他のプログラムの並列動作は無い。Trueだと「非同期」＝他のプログラムも同時進行してしまう。
        
    End With
    
    
    'アクティブウィンドウの調整
    ActiveWindow.Zoom = 75           'ズーム 75%
    o_ImpWSht01jj.Range("A2").Select
    ActiveWindow.FreezePanes = True  'ウィンドウ枠の固定


Exit Sub


error1:


    If Err.Number = 1004 Then
        '「o_QT01jj.Refresh BackgroundQuery:＝=False」で1004番の
        '「アプリケーション定義またはオブジェクト定義のエラーです。」という
        'エラーになった時の処理。
        'SELECT系の命令じゃない時（INSERTやUPDATEなどを使った時）に、
        '1004エラーになるので、その回避。
        
'        o_QT01jj.Refresh BackgroundQuery:=True 'True（非同期）でSQLを実行。Falseだと「同期」で、「同期」だと、他のプログラムの並列動作は無い。Trueだと「非同期」＝他のプログラムも同時進行してしまう。けど、一応実行はできる。
        Debug.Print Err.Description
        Resume Next
        
    Else
    
    End If

    
End Sub


'###############################################################################
'Excelを開かずに、Excelのシート名（テーブル名）を調べる関数
'「sn」は「SheetName」の略です。
'イミディエイトウィンドウでさっと調べたいのであえて短い名前にしてあります。
'###############################################################################

Function sn(s_BkFlpath As String)

    'http://doctorlabo.main.jp/?p=398 を加工。


    
'    Dim s_BkFlpath  As String
    
    Dim i           As Long
    

'    '以下の変数設定を使いたい時は、
'    'VBEの画面にて、以下の２つのライブラリへの「参照設定」が必要です。
'    '・Microsoft ActiveX Data Object 2.8 Library
'    '・Microsoft ADO Ext.2.8 for DDL and Security]
'    Dim cn          As New ADODB.Connection
'    Dim t           As Table
'    Dim ct          As New ADOX.Catalog


    '「参照設定」をしたくないときは以下の変数設定を使います。
    Dim cn          As Object
    Dim t           As Object
    Dim ct          As Object


On Error GoTo error1:

    '★ 設定部
    
    
    '「参照設定」をしたくないときの「ADO」の準備設定
    
    '設定が空の（＝未設定の）ADO用の変数の用意
    Set cn = CreateObject("ADODB.Connection")
    
    '設定が空の（＝未設定の）ADOX用の変数の用意
    Set ct = CreateObject("ADOX.Catalog")
    
    
    '※「参照設定」をしたときは、直上のようなコードは不要です。
    


'    cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.path & "\基本.mdb" & ";"

'    s_BkFlpath = "D:\1\5.xls"
    
'    cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & s_BkFlpath & ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"""
'    cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & s_BkFlpath & ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"""
        
        
    'ExcelファイルへのADO形式での接続
    If 0 < InStr(1, s_BkFlpath, ".xlsm", vbBinaryCompare) Then
    
        cn.Open "Provider=Microsoft.ACE.OLEDB.12.0" & _
                ";Data Source=" & s_BkFlpath & _
                ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"""
    
    ElseIf 0 < InStr(1, s_BkFlpath, ".xlsx", vbBinaryCompare) Then
        
        cn.Open "Provider=Microsoft.ACE.OLEDB.12.0" & _
                ";Data Source=" & s_BkFlpath & _
                ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"""

    ElseIf 0 < InStr(1, s_BkFlpath, ".xls", vbBinaryCompare) Then
    
        '最初にxlsを調べてしまうと、
        'xlsmとxlsxにも反応してしまうので一番最後に調べる
        
        cn.Open "Provider=Microsoft.Jet.OLEDB.4.0" & _
                ";Data Source=" & s_BkFlpath & _
                ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"""
    
    Else

    End If


    'ADO形式で接続したExcelファイルにおいて、
    '「ADOX」の機能を使えるようにする。
       
    ct.ActiveConnection = cn
    
        '    ↑
        '  「ADOX」は、ADO接続をした場合に限り、
        '    「テーブルを作成したり削除したりする」機能です。
        '
        '   ※「ADO」ではなく、「DAO」での接続を使いたい場合では、
        '     「テーブルを作成したり削除したりする機能」は、
        '      最初からその「DAO」単体の中に含まれているため、
        '      このような処理（＝コード）は必要ありません。
                
    
    
    '★ 実動部
             
'    ActiveSheet.Cells.Clear

  
    'すべてのシート名をチェック
    For Each t In ct.Tables
    
'      If t.Type = "TABLE" Then
'        i = i + 1
'        ActiveSheet.Cells(i, 1).Value = t.Name
'      End If
        
        Debug.Print t.Name
        
    Next t
  
    
    cn.Close
    
    Set cn = Nothing
    Set ct = Nothing



Exit Function
error1:

    cn.Close
    
    Set cn = Nothing
    Set ct = Nothing
    
    
End Function


'###############################################################################
'Excelを開かずに、Excelのシート名（テーブル名）と列名を調べる関数
'「sn2」は「SheetName2」の略です。
'イミディエイトウィンドウでさっと調べたいのであえて短い名前にしてあります。
'###############################################################################
 
Function sn2(s_BkFlpath As String)
 
    'http://doctorlabo.main.jp/?p=398 を加工。
 
 
    
'    Dim s_BkFlpath  As String
    
    Dim i           As Long
    
 
'    '以下の変数設定を使いたい時は、
'    'VBEの画面にて、以下の２つのライブラリへの「参照設定」が必要です。
'    '・Microsoft ActiveX Data Object 2.8 Library
'    '・Microsoft ADO Ext.2.8 for DDL and Security]
'    Dim cn          As New ADODB.Connection
'    Dim t           As Table
'    Dim ct          As New ADOX.Catalog
 
 
    '「参照設定」をしたくないときは以下の変数設定を使います。
    Dim cn          As Object
    Dim t           As Object
    Dim ct          As Object
 
 
On Error GoTo error1:
 
    '★ 設定部
    
    
    '「参照設定」をしたくないときの「ADO」の準備設定
    
    '設定が空の（＝未設定の）ADO用の変数の用意
    Set cn = CreateObject("ADODB.Connection")
    
    '設定が空の（＝未設定の）ADOX用の変数の用意
    Set ct = CreateObject("ADOX.Catalog")
    
    
    '※「参照設定」をしたときは、直上のようなコードは不要です。
    
 
 
'    cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.path & "\基本.mdb" & ";"
 
'    s_BkFlpath = "D:\1\5.xls"
    
'    cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & s_BkFlpath & ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"""
'    cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & s_BkFlpath & ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"""
        
        
    'ExcelファイルへのADO形式での接続
    If 0 < InStr(1, s_BkFlpath, ".xlsm", vbBinaryCompare) Then
    
        cn.Open "Provider=Microsoft.ACE.OLEDB.12.0" & _
                ";Data Source=" & s_BkFlpath & _
                ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"""
    
    ElseIf 0 < InStr(1, s_BkFlpath, ".xlsx", vbBinaryCompare) Then
        
        cn.Open "Provider=Microsoft.ACE.OLEDB.12.0" & _
                ";Data Source=" & s_BkFlpath & _
                ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"""
 
    ElseIf 0 < InStr(1, s_BkFlpath, ".xls", vbBinaryCompare) Then
    
        '最初にxlsを調べてしまうと、
        'xlsmとxlsxにも反応してしまうので一番最後に調べる
        
        cn.Open "Provider=Microsoft.Jet.OLEDB.4.0" & _
                ";Data Source=" & s_BkFlpath & _
                ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"""
    
    Else
 
    End If
 
 
    'ADO形式で接続したExcelファイルにおいて、
    '「ADOX」の機能を使えるようにする。
       
    ct.ActiveConnection = cn
    
        '    ↑
        '  「ADOX」は、ADO接続をした場合に限り、
        '    「テーブルを作成したり削除したりする」機能です。
        '
        '   ※「ADO」ではなく、「DAO」での接続を使いたい場合では、
        '     「テーブルを作成したり削除したりする機能」は、
        '      最初からその「DAO」単体の中に含まれているため、
        '      このような処理（＝コード）は必要ありません。
                
    
    
    '★ 実動部
             
'    ActiveSheet.Cells.Clear
 
    Debug.Print "★★★★★★★★★★★★★★★"
 
    'すべてのシート名をチェック（シート名のみ先に全部出す。）
    For Each t In ct.Tables
    
'      If t.Type = "TABLE" Then
'        i = i + 1
'        ActiveSheet.Cells(i, 1).Value = t.Name
'      End If
        
        Debug.Print t.Name
 
    Next t
    
    Debug.Print "★★★★★★★★★★★★★★★"
    Debug.Print "============================="
    
    Dim f01 As Object
  
    'すべてのシート名とそのシートの列名を一覧する。
    For Each t In ct.Tables
    
'      If t.Type = "TABLE" Then
'        i = i + 1
'        ActiveSheet.Cells(i, 1).Value = t.Name
'      End If
        
        Debug.Print t.Name
'        Debug.Print "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~"
        Debug.Print "------------------------"
        
        For Each f01 In t.Columns
            Debug.Print f01.Name
        Next
        
        Debug.Print "============================="
        
    Next t
  
    
    cn.Close
    
    Set cn = Nothing
    Set ct = Nothing
 
 
 
Exit Function
error1:
 
    cn.Close
    
    Set cn = Nothing
    Set ct = Nothing
    
    
End Function

'
'

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

191

192

193

194

195

196

197

198

199

200

201

202

203

204

205

206

207

208

209

210

211

212

213

214

215

216

217

218

219

220

221

222

223

224

225

226

227

228

229

230

231

232

233

234

235

236

237

238

239

240

241

242

243

244

245

246

247

248

249

250

251

252

253

254

255

256

257

258

259

260

261

262

263

264

265

266

267

268

269

270

271

272

273

274

275

276

277

278

279

280

281

282

283

284

285

286

287

288

289

290

291

292

293

294

295

296

297

298

299

300

301

302

303

304

305

306

307

308

309

310

311

312

313

314

315

316

317

318

319

320

321

322

323

324

325

326

327

328

329

330

331

332

333

334

335

336

337

338

339

340

341

342

343

344

345

346

347

348

349

350

351

352

353

354

355

356

357

358

359

360

361

362

363

364

365

366

367

368

369

370

371

372

373

374

375

376

377

378

379

380

381

382

383

384

385

386

387

388

389

390

391

392

393

394

395

396

397

398

399

400

401

402

403

404

405

406

407

408

409

410

411

412

413

414

415

416

417

418

419

420

421

422

423

424

425

426

427

428

429

430

431

432

433

434

435

436

437

438

439

440

441

442

443

444

445

446

447

448

449

450

451

452

453

454

455

456

457

458

459

460

461

462

463

464

465

466

467

468

469

470

471

472

473

474

475

476

477

478

479

480

481

482

483

484

485

486

487

488

489

490

491

492

493

494

495

496

497

498

499

500

501

502

503

504

505

506

507

508

509

510

511

512

513

514

515

516

517

518

519

520

521

522

523

524

525

526

527

528

529

530

531

532

533

534

535

536

537

538

539

540

541

542

543

544

545

546

547

548

549

550

551

552

553

554

555

556

557

558

559

560

561

562

563

564

565

566

567

568

569

570

571

572

573

574

575

576

577

578

579

580

581

582

583

584

585

586

587

588

589

590

591

592

593

594

595

596

597

598

599

600

601

602

603

604

605

606

607

608

609

610

611

612

613

614

615

616

617

618

619

620

621

622

623

624

625

626

627

628

629

630

631

632

633

634

635

636

637

638

639

640

641

642

643

644

645

646

647

648

649

650

651

652

653

654

655

656

657

658

659

660

661

662

663

664

665

666

667

668

669

670

671

672

673

674

675

676

677

678

679

680

681

682

683

684

685

686

687

688

689

690

691

692

693

694

695

696

697

698

699

700

701

702

703

704

705

706

707

708

709

710

711

712

713

714

715

716

717

718

719

720

721

722

723

724

725

726

727

728

729

730

731

732

733

734

735

736

737

738

739

740

741

742

743

744

745

746

747

748

749

750

751

Option Explicit

'###############################################################################

'SQLコマンドの配列（Variant型）を、文字数区切りで生成する関数

'SQL以外にも文字列を文字数区切りで配列化したいときにも使えます。

' Call SQLCmdAryMake01(区切りたい文字列 , 区切る文字数)

'###############################################################################

Function SQLCmdAryMake01(ByVal s_SqlStr01jj As String, ByVal i_SplitNum01 As Integer) As Variant

' Dim s_SqlStr01jj As String

' Dim i_SplitNum01 As Integer 'SQLコマンドの配列に格納するのに、何文字ごとにSplitするかの文字数

Dim Ary_s_SQL01() As Variant

Dim i_Cnt01 As Integer

Dim s_Chunk As String 'Chunk＝かたまり

Dim i_ChunkNum01 As Integer 'i_ChunkNum01＝255文字ごとのかたまりの数（→つまり、要素数になる）

' s_SqlStr01jj = "galgkjaldsgjalsjga"

' i_SplitNum01 = 5

'SQLコマンドの配列の各要素に格納する文字数の設定。256文字以上はダメだった。

i_ChunkNum01 = Len(s_SqlStr01jj) \ i_SplitNum01 + IIf(Len(s_SqlStr01jj) Mod i_SplitNum01 > 0, 1, 0)

'SQLを255文字のかたまりにすると、いくつの要素数になるかの計算。

' Stop

ReDim Ary_s_SQL01(0 To i_ChunkNum01 - 1)

'空の配列を生成。

For i_Cnt01 = 0 To (i_ChunkNum01 - 1)

s_Chunk = Mid(s_SqlStr01jj, i_Cnt01 * i_SplitNum01 + 1, i_SplitNum01)

Ary_s_SQL01(i_Cnt01) = s_Chunk

Next i_Cnt01

' 255文字ずつ取り出して配列に格納するループ。

SQLCmdAryMake01 = Ary_s_SQL01

End Function

'###############################################################################

'指定したシートにて、足らない列名を足すための関数

'###############################################################################

Sub AddNewFld01(o_Ws001 As Worksheet, s_SrchWrd As String, s_StrtCellAdr)

' Dim o_TrgWs001 As Worksheet

Dim o_SearchRange As Range

Dim o_foundCell As Range

Dim l_lastCol As Long

Dim l_CrntRow As Long

' Set o_TrgWs001 = o_Ws001

' ターゲットのシートを設定

l_lastCol = o_Ws001.Range(s_StrtCellAdr).End(xlToRight).Column

'スタートセルの行の右端のセルの列名（R1C1形式の数字）を取得。

l_CrntRow = o_Ws001.Range(s_StrtCellAdr).Row

Set o_SearchRange = o_Ws001.Range(o_Ws001.Range(s_StrtCellAdr).Address, Cells(l_CrntRow, l_lastCol).Address)

'スタートセルの行（列名の入った列）のセル範囲を設定

Set o_foundCell = o_SearchRange.Find(What:=s_SrchWrd, LookAt:=xlWhole, MatchCase:=False)

' 「検索語句」を検索（Find関数を使用）

If o_foundCell Is Nothing Then o_Ws001.Cells(l_CrntRow, l_lastCol + 1).Value = s_SrchWrd

' 「検索語句」が見つからなかった場合、スタートセルの行の最右列の次のセルに「検索語句」を転記

Set o_foundCell = o_SearchRange.Find(What:="", LookAt:=xlPart, MatchCase:=False)

'一応、一般操作画面の検索ダイアログから、今のプロシージャで保存された検索設定を消す。

End Sub

'###############################################################################

'QueryTableオブジェクトの削除（名前の定義も一緒に消えます。）

'###############################################################################

Function QTDelFunc01(o_WSjj As Worksheet)

Dim o_KizonTeigiNm01 As Name

If 1 <= o_WSjj.QueryTables.Count Then

o_WSjj.Activate

o_WSjj.QueryTables(1).Delete

o_WSjj.Rows.Delete

'↑ただの「Cells.ClearContents」だけだと

'何かが残るみたいで自ファイル参照すると

'F1、F2、F3・・・みたいになってしまうことがあるので

'一応、Rows.Deleteにした。でもCells.Deleteのほうがいいのかも？

o_WSjj.Range("A1").Select

Else

End If

'xlsファイル用の名前の定義の削除処理。

'xlsの場合、QueryTableオブジェクトを削除しても

'名前の定義が残ってしまうため。

' o_WSjj.Names(o_WSjj.QueryTables(1).Name).Delete

For Each o_KizonTeigiNm01 In o_WSjj.Names

If 0 < InStr(1, o_KizonTeigiNm01, "", vbBinaryCompare) Then

o_KizonTeigiNm01.Delete

Else

End If

'アクティブウィンドウの調整

ActiveWindow.Zoom = 100 'ズーム 100%

ActiveWindow.FreezePanes = False 'ウィンドウ枠の解除

End Function

'###############################################################################

'指定されたブック内に、指定された名前を含むQueryTableオブジェクトが

'存在するかどうかをチェックしたときに、ヒットしたらメッセージを出すだけの、

'（一応状態も数字で返す）関数。

'###############################################################################

Function QTSonzaiChk01(o_WB02jj As Workbook, s_ChkQTobjNm02jj As String) As Integer

Dim v_Answ01jj As Variant

'★ 実動部

'同じ名前か、ほとんど同じ名前（接尾語があるだけの）の、

'QueryTableオブジェクトが存在するかチェックして

'在れば中断する分岐。

'ちなみに、QueryTableオブジェクトが作成されると、

'名前定義にも勝手に設定が追加されるが、

'QueryTableオブジェクトをDeleteメソッドで削除すると、その設定も一緒に消えます。

'ただ、手動でシート上から手作業でQueryTableオブジェクトを削除すると

'名前定義の設定は残ったままになってしまいます。

v_Answ01jj = KizonQTCheck01(o_WB02jj, s_ChkQTobjNm02jj)

If v_Answ01jj(0) = "OK" Then

QTSonzaiChk01 = 0

ElseIf v_Answ01jj(0) = s_ChkQTobjNm02jj Then

MsgBox "「" & v_Answ01jj(0) & "」を含むQueryTableオブジェクト（＝名前）が、" & _

vbCrLf & "「" & v_Answ01jj(1) & "」として" & _

vbCrLf & "「" & v_Answ01jj(2) & "」に見つかりましたので中断します。" & _

vbCrLf & _

vbCrLf & "付けたい名前を変更して再度実行してください。"

QTSonzaiChk01 = 1

Exit Function

End If

End Function

'###############################################################################

'指定されたブック内に、指定された名前を含むQueryTableオブジェクトが

'存在するかどうかをチェックする関数。

'上記関数の「QTSonzaiChk01」から予備だされます。

'なお、戻り値をVariant型の配列にしてあります。

'戻り値→（チェックする名前,それを含んだ実際のQTの名前,見つかったシート名）の

' Variant型の配列。

'###############################################################################

Function KizonQTCheck01(o_WBjj As Workbook, s_ChkQTNm01jj As String) As Variant

Dim o_KizonQT01jj As QueryTable

Dim o_KizonWSjj As Worksheet

Dim i_EscapeForFlg As Integer

'★ 設定部

Set o_WBjj = ThisWorkbook

i_EscapeForFlg = 0

KizonQTCheck01 = Array("OK", "OK", "OK")

'↑検索がヒットしなかったときの戻り値をあらかじめ設定しておく。

' ヒットすれば、この値が別の配列で上書きされる。

' ※配列で返したい＋初期値を決めておきたいときは、

' あらかじめ配列で初期値を埋めておかないと、

'　呼び出し元のプロシージャ側にての、戻り値でのIf文の判断分岐等々にて、

' 「型が違います」のエラーになるので注意する。

' でも、もっとスマートなやり方があるかもしれない。

'★ 実動部

For Each o_KizonWSjj In o_WBjj.Worksheets

'指定されたQueryTableオブジェクトが存在するかを探すために、

'全シートを移動するループ。親ループ。

' Debug.Print o_KizonWSjj.Name

If i_EscapeForFlg = 1 Then Exit For

'もしヒットしたら、この（全部のシートを順に移動していくという）親ループも抜ける。

'※「i_EscapeForFlg」が１になっていたら、ヒットした、という意味。

For Each o_KizonQT01jj In o_KizonWSjj.QueryTables

'各シートの中のすべてのQueryTableオブジェクトを

'チェックするループ。子ループ。

' Debug.Print o_KizonQT01jj.Name

If 1 <= InStr(1, o_KizonQT01jj.Name, _

s_ChkQTNm01jj, _

vbBinaryCompare) Then

'↑目的のQTオブジェクトがヒットした時はこれ以降↓の処理をする。

' 目的の名前が含まれたQTオブジェクトがヒットしたとき↓。

' Debug.Print "探しているQueryTableオブジェクトがありました。---" & o_KizonQT01jj.Name

If Not (o_KizonWSjj Is ActiveSheet) Then

'もし、目的の名前のQTオブジェクトが見つかったシートが、

'アクティブなシート「以外」であれば、「ヒットした！」と

'みなして以下の処理。

'アクティブなシートに目的のQTオブジェクトが存在してしまっていたなら、

'そのQTは「消しちゃってもいい」ということにして、

'「ヒットしなかったもの」とみなす。

KizonQTCheck01 = Array( _

s_ChkQTNm01jj, _

o_KizonQT01jj.Name, _

o_KizonWSjj.Name)

' ↑ 戻り値（OK・OK・OK）を、ヒット内容に上書き。

i_EscapeForFlg = 1

'ヒットしたことを、親ループを抜けるために、メモ。

Exit For

'この（シート内の全てのQTオブジェクトを調べるという）子ループを抜ける。

Else

End If

Else

' Debug.Print "探しているQueryTableオブジェクトはありません。"

End If

End Function

'###############################################################################

'「テーブル機能」は使わずに、つまり、QueryTableオブジェクトを埋め込まないパターン。

'そして、他の「XLS、XLSM、XLSX」や自ファイルのシートなどを吸い込む関数のサンプル。

'前述の１つ目と同様に、「Microsoft Query」での結合をマクロの記録機能で記録して、<a href="https://euc-access-excel-db.com/tips/ct90_yougo/yougo-sql01" target="_blank" rel="noopener noreferrer">SQL</a>を少し

'短くしただけのコードを、「テーブル機能」に埋め込まないように2行ほど書き換えたもの、を、

'関数化したもの。

'これは「QueryTableオブジェクト」のみで結果を表示しています。

'なお、「Microsoft Query」は、実はExcelからは独立した機能ですが、<a href="https://euc-access-excel-db.com/tips/ct90_yougo/yougo-sql01" target="_blank" rel="noopener noreferrer">SQL</a>実行の結果の表は、

'「QeryTableオブジェクト」に返ってくるように、Excel自身が指示を出しているっぽいです。

'なので、「Microsoft Query」と「QueryTableオブジェクト操作」は、機能は操作は異なりますが、

'結果は「QueryTableオブジェクト」に出力される、「同等なもの」と理解して良さそうです。

' 呼び出し方法

' Call MSQryOnlMakeByODBCFunc001("読みに行きたいファイルのフルパス",

' "そのファイルの在るフォルダのパス",

' SQL文,

' 結果表（QueryTableオブジェクト）につけたい名前,

' 結果を出力したい「オブジェクトとしての」シート.

' 結果表を出力するセルのアドレス（表の一番左上隅のセルの。)

' 例：実際には各行に、「 _ 」（半角での、スペース+アンダーバー）が要ります。

' Call MSQryOnlMakeByODBCFunc001("D:\1\クエリのネストのテスト.xls",

' "D:\1",

' s_SqlStr01jj,

' "QT_To_OwnSheet1",

' ActiveSheet,

' "$A$1")

'###############################################################################

Sub MSQryOnlMakeByODBCFunc001(s_TrgFNm01jj As String, _

s_TrgFPath01jj As String, _

s_Sql01jj As Variant, _

s_QTNm01jj As String, _

o_ImpWSht01jj As Worksheet, _

s_ImpRng01jj As String)

'On Error GoTo error1:

Dim o_QT01jj As QueryTable

Dim i_Answ01 As Integer

'★ チェック部

'最後のチェック

i_Answ01 = MsgBox("本当にQueryTableオブジェクトを作成or書き換えてもいいですか？", vbOKCancel)

If i_Answ01 = 2 Then

Exit Sub '「いいえ」が押されたら終わる。

Else

'それ以外は終わらない。以降の処理を続ける。。

End If

'★ 実動部

'すでにあるQueryTableオブジェクトを処理する

If 1 <= o_ImpWSht01jj.QueryTables.Count Then

o_ImpWSht01jj.QueryTables(1).Delete

' o_ImpWSht01jj.Cells.ClearContents

o_ImpWSht01jj.Rows.Delete

'いったんQueryTableオブジェクトを削除。

'紐ついている名前定義も一緒に消去されます。

Else

End If

'QueryTableオブジェクトの生成

Set o_QT01jj = o_ImpWSht01jj.QueryTables _

.Add(Connection:= _

"ODBC;DSN=Excel Files" & _

";DBQ=" & s_TrgFNm01jj & _

";DefaultDir=" & s_TrgFPath01jj & _

";DriverId=1046" & _

";MaxBufferSize=2048" & _

";PageTimeout=5" & _

";" _

, Destination:=o_ImpWSht01jj.Range(s_ImpRng01jj))

' Stop

With o_QT01jj

' .CommandText = Array(s_Sql01jj)

.CommandText = s_Sql01jj

.RowNumbers = False

.FillAdjacentFormulas = False

.PreserveFormatting = True

.RefreshOnFileOpen = False

.BackgroundQuery = True

.RefreshStyle = xlInsertDeleteCells

.SavePassword = False

.SaveData = True

.AdjustColumnWidth = True

.RefreshPeriod = 0

.PreserveColumnInfo = True

' .ListObject.DisplayName = "テーブル_Excel_Files_からのクエリ4"

'↑この2つ目のサンプルコードは新しいExcelでももちろん動きますが、

' もともとは古いバージョンのExcelのためのものです。

' しかしこの行だけは新しいExcelのためのものです。

' 古いExcelは、最初から「テーブル機能」が使えないので

' 古いExcelでこの2つ目のサンプルを動かすとこの行はエラーになります。

' なので、コメントアウトして、代わりに以下の行で名前を設定しています。

.Name = s_QTNm01jj

.Refresh BackgroundQuery:=False 'False（同期）でSQLを実行。「同期」だと、他のプログラムの並列動作は無い。Trueだと「非同期」＝他のプログラムも同時進行してしまう。

End With

'アクティブウィンドウの調整

ActiveWindow.Zoom = 75 'ズーム 75%

o_ImpWSht01jj.Range("A2").Select

ActiveWindow.FreezePanes = True 'ウィンドウ枠の固定

Exit Sub

error1:

If Err.Number = 1004 Then

'「o_QT01jj.Refresh BackgroundQuery:＝=False」で1004番の

'「アプリケーション定義またはオブジェクト定義のエラーです。」という

'エラーになった時の処理。

'SELECT系の命令じゃない時（INSERTやUPDATEなどを使った時）に、

'1004エラーになるので、その回避。

' o_QT01jj.Refresh BackgroundQuery:=True 'True（非同期）でSQLを実行。Falseだと「同期」で、「同期」だと、他のプログラムの並列動作は無い。Trueだと「非同期」＝他のプログラムも同時進行してしまう。けど、一応実行はできる。

Debug.Print Err.Description

Resume Next

Else

End If

End Sub

'###############################################################################

'Excelを開かずに、Excelのシート名（テーブル名）を調べる関数

'「sn」は「SheetName」の略です。

'イミディエイトウィンドウでさっと調べたいのであえて短い名前にしてあります。

'###############################################################################

Function sn(s_BkFlpath As String)

'http://doctorlabo.main.jp/?p=398 を加工。

' Dim s_BkFlpath As String

Dim i As Long

' '以下の変数設定を使いたい時は、

' 'VBEの画面にて、以下の２つのライブラリへの「参照設定」が必要です。

' '・Microsoft ActiveX Data Object 2.8 Library

' '・Microsoft ADO Ext.2.8 for DDL and Security]

' Dim cn As New ADODB.Connection

' Dim t As Table

' Dim ct As New ADOX.Catalog

'「参照設定」をしたくないときは以下の変数設定を使います。

Dim cn As Object

Dim t As Object

Dim ct As Object

On Error GoTo error1:

'★ 設定部

'「参照設定」をしたくないときの「ADO」の準備設定

'設定が空の（＝未設定の）ADO用の変数の用意

Set cn = CreateObject("ADODB.Connection")

'設定が空の（＝未設定の）ADOX用の変数の用意

Set ct = CreateObject("ADOX.Catalog")

'※「参照設定」をしたときは、直上のようなコードは不要です。

' cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.path & "\基本.mdb" & ";"

' s_BkFlpath = "D:\1\5.xls"

' cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & s_BkFlpath & ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"""

' cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & s_BkFlpath & ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"""

'ExcelファイルへのADO形式での接続

If 0 < InStr(1, s_BkFlpath, ".xlsm", vbBinaryCompare) Then

cn.Open "Provider=Microsoft.ACE.OLEDB.12.0" & _

";Data Source=" & s_BkFlpath & _

";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"""

ElseIf 0 < InStr(1, s_BkFlpath, ".xlsx", vbBinaryCompare) Then

cn.Open "Provider=Microsoft.ACE.OLEDB.12.0" & _

";Data Source=" & s_BkFlpath & _

";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"""

ElseIf 0 < InStr(1, s_BkFlpath, ".xls", vbBinaryCompare) Then

'最初にxlsを調べてしまうと、

'xlsmとxlsxにも反応してしまうので一番最後に調べる

cn.Open "Provider=Microsoft.Jet.OLEDB.4.0" & _

";Data Source=" & s_BkFlpath & _

";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"""

Else

End If

'ADO形式で接続したExcelファイルにおいて、

'「ADOX」の機能を使えるようにする。

ct.ActiveConnection = cn

' ↑

' 「ADOX」は、ADO接続をした場合に限り、

' 「テーブルを作成したり削除したりする」機能です。

' ※「ADO」ではなく、「DAO」での接続を使いたい場合では、

' 「テーブルを作成したり削除したりする機能」は、

' 最初からその「DAO」単体の中に含まれているため、

' このような処理（＝コード）は必要ありません。

'★ 実動部

' ActiveSheet.Cells.Clear

'すべてのシート名をチェック

For Each t In ct.Tables

' If t.Type = "TABLE" Then

' i = i + 1

' ActiveSheet.Cells(i, 1).Value = t.Name

' End If

Debug.Print t.Name

Next t

cn.Close

Set cn = Nothing

Set ct = Nothing

Exit Function

error1:

cn.Close

Set cn = Nothing

Set ct = Nothing

End Function

'###############################################################################

'Excelを開かずに、Excelのシート名（テーブル名）と列名を調べる関数

'「sn2」は「SheetName2」の略です。

'イミディエイトウィンドウでさっと調べたいのであえて短い名前にしてあります。

'###############################################################################

Function sn2(s_BkFlpath As String)

'http://doctorlabo.main.jp/?p=398 を加工。

' Dim s_BkFlpath As String

Dim i As Long

' '以下の変数設定を使いたい時は、

' 'VBEの画面にて、以下の２つのライブラリへの「参照設定」が必要です。

' '・Microsoft ActiveX Data Object 2.8 Library

' '・Microsoft ADO Ext.2.8 for DDL and Security]

' Dim cn As New ADODB.Connection

' Dim t As Table

' Dim ct As New ADOX.Catalog

'「参照設定」をしたくないときは以下の変数設定を使います。

Dim cn As Object

Dim t As Object

Dim ct As Object

On Error GoTo error1:

'★ 設定部

'「参照設定」をしたくないときの「ADO」の準備設定

'設定が空の（＝未設定の）ADO用の変数の用意

Set cn = CreateObject("ADODB.Connection")

'設定が空の（＝未設定の）ADOX用の変数の用意

Set ct = CreateObject("ADOX.Catalog")

'※「参照設定」をしたときは、直上のようなコードは不要です。

' cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.path & "\基本.mdb" & ";"

' s_BkFlpath = "D:\1\5.xls"

' cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & s_BkFlpath & ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"""

' cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & s_BkFlpath & ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"""

'ExcelファイルへのADO形式での接続

If 0 < InStr(1, s_BkFlpath, ".xlsm", vbBinaryCompare) Then

cn.Open "Provider=Microsoft.ACE.OLEDB.12.0" & _

";Data Source=" & s_BkFlpath & _

";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"""

ElseIf 0 < InStr(1, s_BkFlpath, ".xlsx", vbBinaryCompare) Then

cn.Open "Provider=Microsoft.ACE.OLEDB.12.0" & _

";Data Source=" & s_BkFlpath & _

";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"""

ElseIf 0 < InStr(1, s_BkFlpath, ".xls", vbBinaryCompare) Then

'最初にxlsを調べてしまうと、

'xlsmとxlsxにも反応してしまうので一番最後に調べる

cn.Open "Provider=Microsoft.Jet.OLEDB.4.0" & _

";Data Source=" & s_BkFlpath & _

";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"""

Else

End If

'ADO形式で接続したExcelファイルにおいて、

'「ADOX」の機能を使えるようにする。

ct.ActiveConnection = cn

' ↑

' 「ADOX」は、ADO接続をした場合に限り、

' 「テーブルを作成したり削除したりする」機能です。

' ※「ADO」ではなく、「DAO」での接続を使いたい場合では、

' 「テーブルを作成したり削除したりする機能」は、

' 最初からその「DAO」単体の中に含まれているため、

' このような処理（＝コード）は必要ありません。

'★ 実動部

' ActiveSheet.Cells.Clear

Debug.Print "★★★★★★★★★★★★★★★"

'すべてのシート名をチェック（シート名のみ先に全部出す。）

For Each t In ct.Tables

' If t.Type = "TABLE" Then

' i = i + 1

' ActiveSheet.Cells(i, 1).Value = t.Name

' End If

Debug.Print t.Name

Next t

Debug.Print "★★★★★★★★★★★★★★★"

Debug.Print "============================="

Dim f01 As Object

'すべてのシート名とそのシートの列名を一覧する。

For Each t In ct.Tables

' If t.Type = "TABLE" Then

' i = i + 1

' ActiveSheet.Cells(i, 1).Value = t.Name

' End If

Debug.Print t.Name

' Debug.Print "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~"

Debug.Print "------------------------"

For Each f01 In t.Columns

Debug.Print f01.Name

Debug.Print "============================="

Next t

cn.Close

Set cn = Nothing

Set ct = Nothing

Exit Function

error1:

cn.Close

Set cn = Nothing

Set ct = Nothing

End Function

MENU

関連記事

最近の投稿

カテゴリー

MENU

関連記事

最近の投稿

カテゴリー

タグ