我有大约300个Excel文件,它们有一个或多个“Microsoft Query”数据连接,用于从SQL服务器提取数据。我想要一个清单,然后摆脱重复和旧版本。
在每个查询的数据连接属性中都有一个“命令文本”框,其中包含一个Select语句,该语句显示它在SQL服务器上访问的表和视图。我想从所有文件中提取此文本,以便我可以对它们进行评估。
我已经使用VBA来改变命令文本,所以我认为这样做并不困难。但是我对VBA的了解非常有限,尽管进行了大量的研究,我还是找不到起点:如何将命令文本输出到文本文件中。之后,如果文件中有多个查询,应该能够弄清楚如何修改它以立即提取信息。
我发现的一件事是,可能无法单独导出命令文本。当我尝试使用导出到ODC功能时,看起来所有连接属性都包含在内。这很好但我从来没有成功地让它发挥作用。
Application.ActiveWorkbook.ODBCConnection.SaveAsODC ("ODCFile")
提前致谢
答案 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
变量: