Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 10 Pro : Excel 2013)
外部接続のソース書き出しをしたい
投稿日時: 19/12/20 18:04:34
投稿者: あきこさん

今回、このようなファイルを引き継ぎました。超困ってます。
 
1つのexcelファイルに、100個近くの、外部接続で出力されたデータテーブルがあります。
100個とも、MS-Queryを利用して会社のサーバから数値を抽出して落としたものでした。
 
シートも60個くらいあります。
 
これらが、
どのサーバの
どのテーブルから
データを引っ張って来ているのか

どこかに書き出ししたいです。
vbaでやるのがいいと思ったのですが、なかなか参考になる情報が見当たらず…
経験のある方、検討つく方、些細なヒントでも構いませんので情報頂けませんでしょうか
 
当方のvbaスキルは、中級くらいだと思われます。

回答
投稿日時: 19/12/20 19:51:59
投稿者: WinArrow
投稿者のウェブサイトに移動

接続情報が、どこにあるのかを、まず、説明します。
 
シート状のテーブルを選択します。
 
「データ」タブの中の「プロパティ」をクリックします。
「外部データのプロパティ」というダイアログの中の
名前には、データベースのファイル名表示されていると思います。
その右側ボタン(接続のプロパティ)をクリックすると、
「接続のプロパティ」大ログが表示されます。
「定義(D)」タブを選択します。
「接続文字列」というボックスにコネクション文があります。
その下にテーブル名があると思います。

投稿日時: 19/12/21 11:15:08
投稿者: あきこさん

WinArrowさん、いつもありがとうございます。
補足説明いただき、助かります。
 
まさにこの
〉「外部データのプロパティ」というダイアログの中の
〉名前に、データベースのファイル名
 
〉「接続のプロパティ」大ログ「定義(D)」タブ
〉「接続文字列」というボックスにコネクション文があります。
その下にテーブル名があると思います。
 
まさにこの部分をどこかに書き出ししたいと思っています。
 
同じようなファイルが何個もあり、手作業で抜き出すのは時間かかりそうで
どうにか楽な方法でどこかに出力できないかな、と考えています。
 
普段、vbaで外部接続の更新作業・外部接続のsql書き込みはやつているのですが、
既存の接続条件の出力に関しては未経験です。
検索してもそれっぽいものが見つけられずでいます。

回答
投稿日時: 19/12/21 18:05:35
投稿者: WinArrow
投稿者のウェブサイトに移動

>既存の接続条件の出力に関しては未経験です。
 
私も未経験です。
 
テーブルオブジェクト(ListObject オブジェクト)の メンバ
を調査すれば、見えてくると思います。

回答
投稿日時: 19/12/21 19:31:30
投稿者: WinArrow
投稿者のウェブサイトに移動

ヒント
 
Dim TBL As ListObject
 
    Set TBL = ActiveSheet.ListObjects(1)
    With TBL.QueryTable
        Debug.Print "テーブル名:" & .CommandText
        Debug.Print "接続文:" & .Connection
    End With

投稿日時: 19/12/23 10:12:50
投稿者: あきこさん

ありがとうございます。
VBAって、Printメソッドがあるのですね!
ちょっと今から試してきます!!

投稿日時: 19/12/23 10:27:18
投稿者: あきこさん

たびたび恐れ入ります。
外部接続されているシートをアクティブにした状態で下記実行したのですが、
3行め Set TBL = ActiveSheet.ListObjects(1)
「インデックスが有効範囲にありません」と出ます。
 
 
これって、外部接続のMs-Queryが、Excel2007Ver以前の旧テーブルだからでしょうか・・・?
普通、外部接続でデータをDLすると。自動でテーブル(勝手に縞模様になる)
になると思いますが、今回のファイルが、外部接続に限り旧バージョンを使っているよう得です・
 
それとは別問題でしょうか・・・
 
 
 
Dim TBL As ListObject
   
Sub hoge()
     Set TBL = ActiveSheet.ListObjects(1)
     With TBL.QueryTable
         Debug.Print "接続:" & .CommandText
         Debug.Print "接続文:" & .Connection
     End With
End Sub

回答
投稿日時: 19/12/23 11:26:28
投稿者: WinArrow
投稿者のウェブサイトに移動

>今回のファイルが、外部接続に限り旧バージョンを使っているよう得です・
 
旧バージョン
というのがよくわありません。
こちらには、再現できる環境がないので、
回答が難しいです。
 
Debug.print ActiveSheet.ListObjects.Count
 
を実行して、オブジェクト(ListObject)の有無を確認してみましょう。

回答
投稿日時: 19/12/23 13:06:08
投稿者: sk

引用:
1つのexcelファイルに、100個近くの、外部接続で出力されたデータテーブルがあります。
100個とも、MS-Queryを利用して会社のサーバから数値を抽出して落としたものでした。

引用:
これらが、
どのサーバの
どのテーブルから
データを引っ張って来ているのか

どこかに書き出ししたいです。

(標準モジュール)
-------------------------------------------------------------
Sub GetQueryTablesList()
 
    Dim wbkSource As Excel.Workbook
    Dim wstSource As Excel.Worksheet
     
    Dim wbkDestination As Excel.Workbook
    Dim wstDestination As Excel.Worksheet
     
    Dim lst As Excel.ListObject
    Dim qt As Excel.QueryTable
     
    Dim lngRow As Long
     
    Application.ScreenUpdating = False
     
    Set wbkSource = ActiveWorkbook
     
    Set wbkDestination = Workbooks.Add
    Set wstDestination = wbkDestination.Worksheets(1)
     
    lngRow = 1
     
    With wstDestination
        .Name = "クエリーテーブル一覧"
        .Cells(lngRow, 1).Value = "WorksheetName"
        .Cells(lngRow, 2).Value = "ListObjectName"
        .Cells(lngRow, 3).Value = "QueryType"
        .Cells(lngRow, 4).Value = "SourceConnectionFile"
        .Cells(lngRow, 5).Value = "Connection"
        .Cells(lngRow, 6).Value = "CommandType"
        .Cells(lngRow, 7).Value = "CommandText"
        .Range(.Cells(1, 1), .Cells(1, 7)).EntireColumn.ColumnWidth = 50
         
        On Error Resume Next
        For Each wstSource In wbkSource.Worksheets
            For Each qt In wstSource.QueryTables
                lngRow = lngRow + 1
                .Cells(lngRow, 1).Value = wstSource.Name
                .Cells(lngRow, 2).Value = ""
                .Cells(lngRow, 3).Value = qt.QueryType
                .Cells(lngRow, 4).Value = qt.SourceConnectionFile
                .Cells(lngRow, 5).Value = qt.Connection
                .Cells(lngRow, 6).Value = qt.CommandType
                .Cells(lngRow, 7).Value = qt.CommandText
            Next
            For Each lst In wstSource.ListObjects
                Set qt = lst.QueryTable
                lngRow = lngRow + 1
                .Cells(lngRow, 1).Value = wstSource.Name
                .Cells(lngRow, 2).Value = lst.Name
                .Cells(lngRow, 3).Value = qt.QueryType
                .Cells(lngRow, 4).Value = qt.SourceConnectionFile
                .Cells(lngRow, 5).Value = qt.Connection
                .Cells(lngRow, 6).Value = qt.CommandType
                .Cells(lngRow, 7).Value = qt.CommandText
                Set qt = Nothing
            Next
        Next
        On Error GoTo 0
         
        .Range(.Cells(1, 1), .Cells(lngRow, 3)).EntireColumn.AutoFit
        If lngRow > 1 Then
            .Range(.Cells(1, 4), .Cells(lngRow, 7)).WrapText = True
            .Cells.EntireRow.AutoFit
        End If
     
    End With
     
    Application.ScreenUpdating = True
     
End Sub
------------------------------------------------------------
 
以上のようなコードを実行なさりたいということでしょうか。

投稿日時: 19/12/23 15:31:57
投稿者: あきこさん

sk さん
すすすすすすごい!!
まさにやりたかったことです。
ありがとうございます。そのままいただいてしまいました。恐縮です・・・。
 
.ListObject をそのまま表示してみても では なぜが個数ゼロだったのですが
skさんのコードではきれいにすべてが表示されました。
 
これを基にもっともっと精進いたします。
 
 
WinArrowさん、SKさん、ありがとうございました!!!
お二人に近づけるようにがんばります!