提取Excel数据连接命令文本

时间:2015-02-13 01:26:09

标签: excel vba

我有大约300个Excel文件,它们有一个或多个“Microsoft Query”数据连接,用于从SQL服务器提取数据。我想要一个清单,然后摆脱重复和旧版本。

在每个查询的数据连接属性中都有一个“命令文本”框,其中包含一个Select语句,该语句显示它在SQL服务器上访问的表和视图。我想从所有文件中提取此文本,以便我可以对它们进行评估。

我已经使用VBA来改变命令文本,所以我认为这样做并不困难。但是我对VBA的了解非常有限,尽管进行了大量的研究,我还是找不到起点:如何将命令文本输出到文本文件中。之后,如果文件中有多个查询,应该能够弄清楚如何修改它以立即提取信息。

我发现的一件事是,可能无法单独导出命令文本。当我尝试使用导出到ODC功能时,看起来所有连接属性都包含在内。这很好但我从来没有成功地让它发挥作用。

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

提前致谢

1 个答案:

答案 0 :(得分:2)

此处的主模块遍历您指定的文件夹中的所有Excel工作簿,并为每个工作表中的每个ListObject列出CommandText和SourceConnectionFile。 ListObjects(Tables)不一定有数据连接,所以我通过检查ListObject是否有一个QueryTable来测试它,这应该意味着它有一个连接。请注意,这仅适用于Excel 2007中 - 在2003年,QueryTables独立存在。

有两个函数:一个用于测试QueryTable,如post of mine中所述;并且可以将所有Excel工作簿放在一个文件夹中。

输出打印到与运行此代码的工作簿相同的文件夹中的文本文件。

我对此进行了一些测试并且有效,但我并没有非常努力地让它失败:

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

编辑 - 使用Excel 2003,其中QueryTables是Worksheet对象的直接成员。请注意,这是未经测试的内存。它很接近,我确定,如果需要的话,稍微调查一下Excel 2003 QueryTable对象会有所帮助。

替换它:

    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

......用这个:

    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

请注意,此版本中不需要lo变量: