Daten von SQL-DB in Excel

  • VBScript

Es gibt 4 Antworten in diesem Thema. Der letzte Beitrag () ist von Ovoxo.

    Daten von SQL-DB in Excel

    Hallo zusammen,

    Ich habe ein Problem. Ich versuche via VBScript Daten von meiner DB zu holen und in Excel-Files zu schreiben.
    De Prozess lauft im Hintergrund ab und ich sollte 5 Excel-Files erhalten. Sobald ein File fertig ist, wird es auf dem Desktop gespeichert und das nächste wird bearbeitet.
    Das funktioniert alles wunder. Nur das Problem ist, sobald ein File fertig ist und ich es öffne, lädt es auch das File welches gerade abgefüllt wird.
    Nun erhalte ich eine Error-Meldung, sobald ich im bearbeitenden File in ein leeres Feld klicke.

    Wie kann ich das beheben?

    Hoffe habe es irgendwie verständlich formuliert.

    Quellcode

    1. Option Explicit
    3. DIM Cn, sql, rs, item, objExcel, objWorkbook, objWorksheet, count, FileName, check
    4. DIM i, x, z, y, b, n, q, a
    5. Dim arrItem(300)
    6. Dim arrDB
    7. Dim arrCondition
    8. Dim arrContens
    9. Dim arrTitle
    10. Dim arrText
    11. arrCondition = Array("Mitgliedtyp","Mitgliedtyp","BusinessRelation","FachzeitschriftAbo","FachzeitschriftMAGeschenk","ZeitschriftAboKontakt","FachzeitschriftGratisAbo","ZeitschriftAboGratis")
    12. arrDB = Array("Companies","Companies","Companies","Companies","Contacts","Contacts","Companies","Contacts")
    13. arrContens = Array(1,2,8,1,1,1,1,1)
    14. arrTitle = Array("Aktivmitglieder","Passivmitglieder","Partner","Fachzeitschriften_(zahlbar)","Fachzeitschriften_Mitarbeiter","Fachzeitschrift_(zahlbar)","Fachzeitschrift_Gratis","Fachzeitschrift_Gratis")
    15. arrText = Array("Mitglieder","Firma_Fachzeitschriften","Kontakt_Fachzeitschriften","Firma_Fachzeitschriften_Gratisabo","Kontakt_Fachzeitschriften_Gratisabo")
    16. i = 0
    17. x = 0
    18. Z = 1
    19. y = 0
    20. b = 2
    21. n = 0
    22. a = 1
    23. q = true
    24. check = true
    26. SET Cn = CreateObject("ADODB.Connection")
    27. Set objExcel = CreateObject("Excel.Application")
    29. objExcel.Visible = false
    31. Cn.ConnectionString = "Provider = SQLOLEDB; Data Source = DB; User ID = User; Password = PW; Initial Catalog = Tabelle;"
    32. Cn.Open 'Verbindung herstellen Combit DB
    34. Aktivmitglieder()
    36. IF Cn.State = 1 THEN
    37. Cn.Close
    38. objExcel.DisplayAlerts = false
    39. objExcel.Quit
    40. SET Cn = Nothing
    41. set objExcel = Nothing
    42. set objWorkbook = Nothing
    43. Set objWorksheet = Nothing
    44. MsgBox("Closed")
    45. ELSE
    46. MsgBox("Failed")
    47. END IF
    49. Sub Aktivmitglieder()
    50. While check = true
    51. if(q = true) then
    52. Set objWorkbook = objExcel.Workbooks.Add()
    53. q = false
    54. END if
    55. If(n >= 7) then
    56. check = false
    57. End If
    59. Set objWorksheet = objWorkbook.Worksheets(a)
    60. objWorksheet.Name = arrTitle(i)
    61. objExcel.Cells.EntireColumn.AutoFit
    62. Filename = "C:\Users\Administrator\Desktop\" & arrText(x) & ".xlsx"
    64. sql = "SELECT COUNT(*) FROM dbo." & arrDB(i) & " Where " & arrCondition(i) & "=" & arrContens(i)
    65. SET rs = Cn.Execute(sql)
    66. count = rs(0)
    68. IF (count = 0) OR (IsNull(count)) THEN
    69. MsgBox("No Items Found")
    70. ELSE
    71. sql = "SELECT COLUMN_NAME FROM information_schema.COLUMNS WHERE table_name = '" & arrDB(i) & "'"
    72. SET rs = Cn.Execute(sql)
    74. Do UNTIL rs.EOF
    75. for each item IN rs.Fields
    76. if (item = "") OR (IsNull(item)) then
    77. arrItem(y) = "Empty"
    78. ELSE
    79. arrItem(y) = item
    80. END IF
    81. objWorksheet.Cells(1,z).Font.FontStyle = "Bold"
    82. objWorksheet.Cells(1,z)= arrItem(y)
    83. z = z + 1
    84. y = y + 1
    85. Next
    86. rs.MoveNext
    87. Loop
    88. y = 0
    89. Z = 1
    90. sql = "SELECT * FROM dbo." & arrDB(i) & " Where " & arrCondition(i) & "=" & arrContens(i)
    91. SET rs = Cn.Execute(sql)
    92. DO UNTIL rs.EOF
    93. For Each item IN rs.Fields
    94. IF (item = "") OR (IsNull(item)) THEN
    95. arrItem(y) = ""
    96. ELSE
    97. arrItem(y) = item
    98. END IF
    99. objWorksheet.Cells(b,z)= arrItem(y)
    100. y = y + 1
    101. z = z + 1
    102. NEXT
    103. b = b + 1
    104. y = 0
    105. z = 1
    106. rs.MoveNext
    107. LOOP
    108. i = i + 1
    109. b = 2
    110. n = n + 1
    111. a = a + 1
    112. If(n = 3) or (n = 4) or (n = 6) or (n = 7) or (n = 8) then
    113. q = true
    114. x = x + 1
    115. a = 1
    116. objWorkbook.SaveAs FileName
    117. END IF
    118. END If
    119. Wend
    120. END SUB
    Bilder

    • 25-03-2015 13-36-02.jpg

      36,64 kB, 478×239, 155 mal angesehen

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

    Ich nehme an, dass dein Recordset mehr als 300 Einträge hat und damit dein Array sprengt.

    Tipp:
    Verwende einen vernünftigen Debugger, z.B. VBSedit

    Alternativ kannst du das Script auch in Excel entwickeln.
    Dazu musst du die Main-Routine halt in ein Sub packen.
    Wenn es zufriedenstellend läuft, kannst du es immer noch in VBS zurück konvertieren.
    --
    If Not Program.isWorking Then Code.Debug Else Code.DoNotTouch
    --

    Leider liegt es nicht am Recordset, habe es geprüft sind nicht mehr als 300 Einträge.
    Gibt es eine Möglichkeit die FIles in einen Ordner zu speichern und diesen solange unsichtbar lassen bis es abgeschlossen ist?

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

    Ovoxo schrieb:

    Leider liegt es nicht am Recordset, habe es geprüft sind nicht mehr als 300 Einträge.
    Es wird dir nichts übrig bleiben, als das Script in einer vernünftigen Umgebung zu entwickeln.
    Wie gesagt: VBSedit oder Excel.
    Mit dem Texteditor wirst du an jeder Stolperstelle auf die Schnauze fallen.

    Ovoxo schrieb:

    Gibt es eine Möglichkeit die FIles in einen Ordner zu speichern und diesen solange unsichtbar lassen bis es abgeschlossen ist?
    Nicht wirklich. Es gibt zwar ein Hidden-Attribut, aber das macht sie nicht wirklich unsichtbar.
    Du kannst Dateien in einem temporären Ordner speichern und sie nach Fertigstellung an den endgültigen Platz verschieben.
    --
    If Not Program.isWorking Then Code.Debug Else Code.DoNotTouch
    --

Facebook