Extracting Excel Data Connection Command Text

2019-08-08 03:43发布

I have about 300 Excel files that have one or more "Microsoft Query" data connection that pulls data from a SQL server. I would like to take an inventory, then get rid of duplicates and old versions.

In each query's data connection properties is a "Command Text" box that contains a Select statement that shows what tables and views it is accessing on the SQL server. I would like to pull this text out of all the files so I can evaluate them.

I've used VBA to alter the Command Text so I didn't think it would be that difficult to do this. But my knowledge of VBA is pretty limited and despite a lot of research I haven't been able find the starting point: how to get the command text out into a text file. After that, should be able to figure out how to modify it to pull the info at once if there are multiple queries in the file.

One thing I did discover is that it may not be possible to just export the Command Text alone. When I was trying to use export to ODC functionality, it looked like all the connection properties were included. That was fine but I never had any success in getting it to work.

Application.ActiveWorkbook.ODBCConnection.SaveAsODC ("ODCFile")

Thanks in advance

标签: excel vba
1条回答
乱世女痞
2楼-- · 2019-08-08 04:31

The main module here loops through all the Excel workbooks in a folder you specify and lists the CommandText and SourceConnectionFile for each ListObject in each worksheet. ListObjects (Tables) don't necessarily have data connection, so I test for that by checking if the ListObject has a QueryTable which should mean it has a connection. NOTE that this is only true in Excel 2007 on - in 2003 QueryTables stood on their own.

There's two functions: one that tests for a QueryTable, as discussed in this post of mine; and one that gets all the Excel workbooks in a folder.

The output is printed to a text file in the same folder as the workbook this code is run from.

I tested this a bit and it worked, but I didn't try very hard to make it fail:

Sub ListCommandTexts()
Dim WorkbooksToCheck() As String
Dim WbIndex As Long
Dim wb As Excel.Workbook
Dim ws As Excel.Worksheet
Dim lo As Excel.ListObject
Dim qt As Excel.QueryTable

On Error GoTo Exit_Point
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False

'your log file will be in this workbook's folder
Open ThisWorkbook.Path & Application.PathSeparator & "CommandTextLog.txt" For Append As #1

'gets all workbook names in folder
'(see function below)
WorkbooksToCheck() = GetWorkbookNames("c:\Test\") 'modify for your folder
For WbIndex = LBound(WorkbooksToCheck) To UBound(WorkbooksToCheck)
    Set wb = Workbooks.Open(Filename:=WorkbooksToCheck(WbIndex), UpdateLinks:=False)
    For Each ws In wb.Worksheets
        For Each lo In ws.ListObjects
            'if listobject has no querytable, just slide on by
            '(see function below)
            Set qt = GetListObjectQueryTable(lo)
            If Not qt Is Nothing Then
                Print #1, wb.Name & "; " & ws.Name & "; " & lo.Name & "; " & qt.CommandText & "; " & qt.SourceConnectionFile
            End If
        Next lo
    Next ws
    wb.Close savechanges:=False
Next WbIndex

Exit_Point:
Close #1
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
Exit Sub

err_handler:
Debug.Print Err.Number & "; " & Err.Description
GoTo Exit_Point
End Sub


Function GetWorkbookNames(strSourceFolder As String) As String()
Dim fso As Object 'Scripting.FileSystemObject
Dim SourceFolder As Object
Dim FileItem As Object
Dim strWorkbookNames() As String
Dim i As Long

Set fso = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = fso.GetFolder(strSourceFolder)
i = 0
With SourceFolder
    For Each FileItem In SourceFolder.Files
        If FileItem.Type = "Microsoft Excel Worksheet" Or FileItem.Type = "Microsoft Excel 97-2003 Worksheet" Then
            i = i + 1
            ReDim Preserve strWorkbookNames(1 To i)
            strWorkbookNames(i) = FileItem.Path
        End If
    Next FileItem
End With
GetWorkbookNames = strWorkbookNames()
Set SourceFolder = Nothing
Set fso = Nothing
End Function


Function GetListObjectQueryTable(lo As Excel.ListObject) As Excel.QueryTable
On Error Resume Next
Set GetListObjectQueryTable = lo.QueryTable
End Function

EDIT - Using Excel 2003, where QueryTables are a direct member of the Worksheet object. Note that this is untested and from memory. It's close, I'm sure, and a little looking into the Excel 2003 QueryTable object will help if needed.

Replace this:

    For Each ws In wb.Worksheets
        For Each lo In ws.ListObjects
            'if listobject has no querytable, just slide on by
            '(see function below)
            Set qt = GetListObjectQueryTable(lo)
            If Not qt Is Nothing Then
                Print #1, wb.Name & "; " & ws.Name & "; " & lo.Name & "; " & qt.CommandText & "; " & qt.SourceConnectionFile
            End If
        Next lo
    Next ws

... with this:

    For Each ws In wb.Worksheets
        For Each qt In ws.QueryTables
            Print #1, wb.Name & "; " & ws.Name & "; " & qt.CommandText & "; " & qt.SourceConnectionFile
        Next qt
    Next ws

Note that the lo variable isn't needed in this version:

查看更多
登录 后发表回答