Exceldateien durchsuchen, die Abfragen auf SQL Server stellen

  • Excel

Es gibt 2 Antworten in diesem Thema. Der letzte Beitrag () ist von Bot-Like.

    Exceldateien durchsuchen, die Abfragen auf SQL Server stellen

    Hallo an Alle,

    ich brauche mal einen Excel-perten der mir weiterhilft. Wir haben die Aufgabe bekommen, dass wir das Ganze Firmennetzwerk auf Exceldateien durchsuchen sollen, die Abfragen zu unserem SQL Server stellen.
    Das habe ich auch soweit hinbekommen. Nur scheitere ich jetzt leider an einem Detail. Ich kannte bisher nur die Möglichkeit, dass man eine Abfrage in Excel erstellt, die dan in Tabellenform erstellt wird.
    Diese wird auch problemlos von unten stehendem Code gefunden.
    Kollegen (die nicht mehr bei uns arbeiten) haben aber auch Excel-Tools erstellt, bei den die Abfragen direkt in eine Pivot Tabelle münden.
    Augenscheinlich sind das die Problemkinder die von meinem code nicht erfasst werden.

    Habt Ihr schonmal von sowas gehört?


    Visual Basic-Quellcode

    1. Function QuerysAuslesen(ByVal Excel_Datei_Pfad)
    2. On Error GoTo Fehlerbehandlung
    3. Set AktionSHELL = CreateObject("WScript.Shell")
    4. DesktopPfad = AktionSHELL.SpecialFolders("Desktop")
    5. Textdatei_pfad = DesktopPfad & "\Excel_documents_with_querys.txt"
    6. Application.Workbooks.Open Excel_Datei_Pfad, False, True
    7. Dim qrt As QueryTable, objListObject As ListObject, iIndex As Integer
    8. Dim wsh As Worksheet
    9. Dim bAddList As Boolean
    10. Dim qrt_Anzahl As Integer
    11. qrt_Anzahl = 0
    12. QUERY_STRING = ""
    13. For Each wsh In ActiveWorkbook.Worksheets
    14. For Each qrt In wsh.QueryTables
    15. qrt_Anzahl = qrt_Anzahl + 1
    16. Reiter = wsh.Name
    17. Verbindungs_zeichen_folge = qrt.Connection
    18. Abfrage = qrt.Sql
    19. Abfrage = Replace(Abfrage, vbCrLf, " ")
    20. Abfrage = Replace(Abfrage, vbCr, " ")
    21. Abfrage = Replace(Abfrage, vbLf, " ")
    22. Abfrage = Replace(Abfrage, vbTab, " ")
    23. Pfad_zerlegen ActiveWorkbook.FullName, Verzeichnis, Dateiname, Dateiendung
    24. Date_LastAccessed = Dateieigenschaften_auslesen_vba(ActiveWorkbook.FullName, "Date_LastAccessed")
    25. QUERY_STRING = vbTab & Dateiname & "." & Dateiendung & vbTab & Verzeichnis & vbTab & vbTab & Abfrage & vbTab & vbTab & Date_LastAccessed & vbTab & Verbindungs_zeichen_folge & vbTab & Reiter
    26. Text_Datei_Schreiben QUERY_STRING, Textdatei_pfad
    27. Next
    28. iIndex = 0
    29. For Each objListObject In wsh.ListObjects
    30. iIndex = iIndex + 1
    31. With objListObject
    32. If .SourceType = xlSrcQuery Then
    33. Set qrt = .QueryTable
    34. qrt_Anzahl = qrt_Anzahl + 1
    35. Reiter = wsh.Name
    36. Verbindungs_zeichen_folge = qrt.Connection
    37. Abfrage = qrt.Sql
    38. Abfrage = Replace(Abfrage, vbCrLf, " ")
    39. Abfrage = Replace(Abfrage, vbCr, " ")
    40. Abfrage = Replace(Abfrage, vbLf, " ")
    41. Abfrage = Replace(Abfrage, vbTab, " ")
    42. Pfad_zerlegen ActiveWorkbook.FullName, Verzeichnis, Dateiname, Dateiendung
    43. Date_LastAccessed = Dateieigenschaften_auslesen_vba(ActiveWorkbook.FullName, "Date_LastAccessed")
    44. QUERY_STRING = vbTab & Dateiname & "." & Dateiendung & vbTab & Verzeichnis & vbTab & vbTab & Abfrage & vbTab & vbTab & Date_LastAccessed & vbTab & Verbindungs_zeichen_folge & vbTab & Reiter
    45. Text_Datei_Schreiben QUERY_STRING, Textdatei_pfad
    46. End If
    47. End With
    48. Next
    49. Next
    50. ActiveWorkbook.Close False
    51. Fehlerbehandlung:
    52. If Err.Number = 1004 Then
    53. Exit Function
    54. Resume
    55. End If
    56. End Function

    Bilder
    • SqlPivot_WIRD_NICHT_ERFASST.jpg

      130,32 kB, 1.366×623, 159 mal angesehen
    • SqlTbl_WIRD_ERFASST.jpg

      126,22 kB, 1.360×608, 163 mal angesehen

    Dieser Beitrag wurde bereits 2 mal editiert, zuletzt von „Bot-Like“ ()

    Hi,

    die Vermutung mit dem Pivot hat sich nicht bewahrheitet.
    Ich habe noch eine Andere Möglichkeit gefunden die Verbindungen auszulesen. Da war dann alles mit dabei was ich brauchte.
    Vorher hatte es OLEDBConnections glaube ich nicht mit erfasst.

    Jedenfalls findet Ihr unten nochmal das komplette Macro, falls das noch jemand verwerten kann.
    Spoiler anzeigen

    Visual Basic-Quellcode

    1. Sub Main()
    2. Titel = "Excel Dateien mit Query suchen"
    3. Main_Verzeichnis = InputBox("Bitte geben Sie ein UNC Verzeichnis an, dass Sie durchsuchen wollen", Titel, "C:\Users\???\Desktop\Neuer Ordner")
    4. If Main_Verzeichnis <> "" Then
    5. AlleDateien Main_Verzeichnis
    6. End If
    7. MsgBox "Das Ergebnis liegt auf Ihrem Desktop, als Textdatei.", vbInformation, Titel
    8. End Sub
    9. Function AlleDateien(ByVal Pfad As String)
    10. Dim ScriptObject As Object
    11. Set ScriptObject = CreateObject("Scripting.FileSystemObject")
    12. Dim StartOrdner As Object
    13. Set StartOrdner = ScriptObject.GetFolder(Pfad)
    14. Dateien StartOrdner.Files
    15. Ordner StartOrdner
    16. End Function
    17. Private Sub Dateien(Ordner As Object)
    18. Dim Datei As Object
    19. For Each Datei In Ordner
    20. File_Name = Datei.Name
    21. File_Path = Datei.Path
    22. If (InStr(UCase(File_Name), ".XLSX") <> 0 Or InStr(UCase(File_Name), ".XLSM") <> 0) And Left(File_Name, 2) <> "~$" Then
    23. Set AktionSHELL = CreateObject("WScript.Shell")
    24. DesktopPfad = AktionSHELL.SpecialFolders("Desktop")
    25. INI_FILE = DesktopPfad & "\Search_for_Excel_documents_with_querys_PROBLEMFILES.txt"
    26. Dateigröße = Dateieigenschaften_auslesen_vba(File_Path, "Size")
    27. Auslassen = INI_auslesen_angepasst(INI_FILE, File_Path)
    28. If Dateigröße > 5000 And Auslassen = False Then
    29. QuerysAuslesen (File_Path)
    30. End If
    31. End If
    32. Next
    33. End Sub
    34. Function Ordner(objOrdner As Object)
    35. Dim Unterordner As Object
    36. For Each Unterordner In objOrdner.SubFolders
    37. Dateien Unterordner.Files
    38. Ordner Unterordner
    39. Next
    40. End Function
    41. Function QuerysAuslesen(ByVal Excel_Datei_Pfad)
    42. Dim pt As PivotTable
    43. On Error GoTo Fehlerbehandlung
    44. Set AktionSHELL = CreateObject("WScript.Shell")
    45. DesktopPfad = AktionSHELL.SpecialFolders("Desktop")
    46. Textdatei_pfad = DesktopPfad & "\Excel_documents_with_querys.txt"
    47. Application.Workbooks.Open Excel_Datei_Pfad, False, True
    48. Dim qrt As QueryTable, objListObject As ListObject, iIndex As Integer
    49. Dim wsh As Worksheet
    50. Dim bAddList As Boolean
    51. Dim qrt_Anzahl As Integer
    52. qrt_Anzahl = 0
    53. QUERY_STRING = ""
    54. Text_schreiben_erlaubt = False
    55. Verbindungs_Anzahl = ActiveWorkbook.Connections.Count
    56. For i = 1 To Verbindungs_Anzahl
    57. Verbindungsname = ActiveWorkbook.Connections.Item(i).Name
    58. Vebindungstyp = ActiveWorkbook.Connections.Item(i).Type
    59. If Vebindungstyp = 1 Then
    60. Abfrage = ActiveWorkbook.Connections.Item(i).OLEDBConnection.CommandText
    61. Verbindungs_zeichen_folge = ActiveWorkbook.Connections.Item(i).OLEDBConnection.Connection
    62. Text_schreiben_erlaubt = True
    63. ElseIf Vebindungstyp = 2 Then
    64. Abfrage = ActiveWorkbook.Connections.Item(i).ODBCConnection.CommandText
    65. Verbindungs_zeichen_folge = ActiveWorkbook.Connections.Item(i).ODBCConnection.Connection
    66. Text_schreiben_erlaubt = True
    67. Else
    68. Text_schreiben_erlaubt = False
    69. End If
    70. If Text_schreiben_erlaubt = True Then
    71. Abfrage = Replace(Abfrage, vbCrLf, " ")
    72. Abfrage = Replace(Abfrage, vbCr, " ")
    73. Abfrage = Replace(Abfrage, vbLf, " ")
    74. Abfrage = Replace(Abfrage, vbTab, " ")
    75. Pfad_zerlegen ActiveWorkbook.FullName, Verzeichnis, Dateiname, Dateiendung
    76. Date_LastAccessed = Dateieigenschaften_auslesen_vba(ActiveWorkbook.FullName, "Date_LastAccessed")
    77. If Len(Abfrage) > 32700 Then
    78. QUERY_STRING = vbTab & Dateiname & "." & Dateiendung & vbTab & Verzeichnis & vbTab & vbTab
    79. QUERY_STRING = QUERY_STRING & Left(Abfrage, 32700) & vbTab & vbTab & Date_LastAccessed & vbTab & Verbindungs_zeichen_folge & vbTab
    80. QUERY_STRING = QUERY_STRING & "ATTENTION the SQL code was too long for an Excel cell and is continued in the last column" & vbTab & Mid(Abfrage, 32701, Len(Abfrage) - 32700)
    81. Else
    82. QUERY_STRING = vbTab & Dateiname & "." & Dateiendung & vbTab & Verzeichnis & vbTab & vbTab
    83. QUERY_STRING = QUERY_STRING & Abfrage & vbTab & vbTab & Date_LastAccessed & vbTab & Verbindungs_zeichen_folge
    84. End If
    85. Text_Datei_Schreiben QUERY_STRING, Textdatei_pfad
    86. End If
    87. Next
    88. ActiveWorkbook.Close False
    89. Fehlerbehandlung:
    90. If Err.Number = 1004 Then
    91. Exit Function
    92. Resume
    93. End If
    94. End Function
    95. Function Pfad_zerlegen(ByVal Pfad, ByRef Verzeichnis, ByRef Dateiname, ByRef Dateiendung)
    96. Pfad_array = Split(Pfad, "\")
    97. Dateiname_mit_Erweiterung = Pfad_array(UBound(Pfad_array))
    98. Verzeichnis = Replace(Pfad, "\" & Dateiname_mit_Erweiterung, "")
    99. Dateiname_array = Split(Dateiname_mit_Erweiterung, ".")
    100. Dateiendung = Dateiname_array(UBound(Dateiname_array))
    101. Dateiname = Dateiname_array(0)
    102. End Function
    103. Function Text_Datei_Schreiben(ByVal InputString, ByVal Zielpfad)
    104. Set AktionFSO = CreateObject("Scripting.FileSystemObject")
    105. If AktionFSO.FileExists(Zielpfad) = False Then
    106. AktionFSO.CreateTextFile (Zielpfad)
    107. End If
    108. Set Datei = AktionFSO.OpenTextFile(Zielpfad, 8)
    109. Datei.Writeline InputString
    110. Datei.Close
    111. End Function
    112. Function Dateieigenschaften_auslesen_vba(ByVal Dateipfad, ByVal gesuchter_Wert)
    113. Set fs = CreateObject("Scripting.FileSystemObject")
    114. Set f = fs.GetFile(Dateipfad)
    115. Date_LastModified = f.DateLastModified
    116. Date_Created = f.DateCreated
    117. Date_LastAccessed = f.DateLastAccessed
    118. Size = f.Size
    119. Typ = f.Type
    120. If gesuchter_Wert = "Date_LastModified" Then
    121. Dateieigenschaften_auslesen_vba = Date_LastModified
    122. ElseIf gesuchter_Wert = "Date_Created" Then
    123. Dateieigenschaften_auslesen_vba = Date_Created
    124. ElseIf gesuchter_Wert = "Date_LastAccessed" Then
    125. Dateieigenschaften_auslesen_vba = Date_LastAccessed
    126. ElseIf gesuchter_Wert = "Size" Then
    127. Dateieigenschaften_auslesen_vba = Size
    128. ElseIf gesuchter_Wert = "Typ" Then
    129. Dateieigenschaften_auslesen_vba = Typ
    130. Else
    131. Dateieigenschaften_auslesen_vba = ""
    132. End If
    133. End Function
    134. Function INI_auslesen_angepasst(ByVal INI_FILE, ByVal Inputwert)
    135. Set AktionFSO = CreateObject("Scripting.FileSystemObject")
    136. Set AktionSHELL = CreateObject("WScript.Shell")
    137. DesktopPfad = AktionSHELL.SpecialFolders("Desktop")
    138. Ergebnis = False
    139. If AktionFSO.FileExists(INI_FILE) = False Then
    140. INI_auslesen_angepasst = Ergebnis
    141. Exit Function
    142. End If
    143. Set INI_Datei = AktionFSO.OpenTextFile(INI_FILE, 1)
    144. While Not INI_Datei.AtEndOfStream
    145. INI_Textzeile = INI_Datei.Readline
    146. If Inputwert = INI_Textzeile Then
    147. Ergebnis = True
    148. End If
    149. Wend
    150. INI_Datei.Close
    151. INI_auslesen_angepasst = Ergebnis
    152. End Function



    aufgrund des Codeumfangs Spoiler hinzugefügt ~VaporiZed

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „VaporiZed“ ()