Excel 2010 VBA automatisch erweitern mit Datensätze aus Tabelle

Hallo,

ich habe eine Excel Tabelle QUELLE wo Worte (Datenbanken) untereinander stehen.
Diese Datenbanken versuche ich per VBA in Sheets einzulesen. Um die Funktionen nicht immer manuell anzlegen zu müssen
möchte ich dieses irgendwie per VBA hin bekommen.

Hierzu verwende ich eine Funktion, in welcher ich Public Funktionen aufrufe

Die Public Funktionen sind immer identisch,
Nun möchte ich erreichen, dass per VBA automatisch anhand der Wörter aus der Tabelle QUELLE die Public Funktion angelegt wird ( mit den an den Testellen TEST bzw TEST1) angelegten Wörten.
Gleichzeitig soll geprüft werden ob die Tabellenblätter bereits vorhanden sind, falls nicht soll diese angelegt werden, weiter soll die Function_Daten_Laden mit den Wörtern aus der Tabelle mit der PublicFunktion automatisch erweitert werden.

Ich habe meine Codes mal angefügt.
Im Tabellenblatt QUELLE stehen die Werte untereinander, für welche ich das VBA automatisch erweitern möchte.

vielleicht kann mir hier jemand helfen um das Problem zu lösen (Es handelt sich hierbei um gut 180 Datenbanken die eingelesen werden sollen)

Function Daten_laden()

verlassen = False

TEST

If verlassen = True Then

verlassen = False

Exit Function

End If              'Wenn bei der ersten abfragen ein Fehler auftritt wird abgerochen  

TEST1

MSGbox " Die Daten wurden erfolgreich geladen! "  

End Function

Public Sub TEST() ' As Long  
   
   Dim objCQI As cqi
   'Login übernehmen  
   Login objCQI
   'löschen der alten Daten  
    Sheets("TEST").Select  
    Cells.Select
    Selection.ClearContents
  
   Dim sql As String, tblname As String, Server As String
   
   sql = "select * from TEST"  
        
 
   tblname = "TEST"  
   
   ' Protkollierung Startzeitpunkt der Verarbeitung  
   'Debug.Print "start CQI Verarbeitung : " & Format(Now, "hh:nn:ss")  
       
   Dim resultOfAction As String
   
   Dim stat As RETCODE
   ' Absetzen der Query  
   stat = objCQI.DoRequest4XL(ActiveWorkbook.ActiveSheet, sql, tblname, resultOfAction)
   If stat <> RETCODE.ok Then
   '   Debug.Print "Fehler bei HTTP-Request:" & vbCrLf & resultOfAction & vbCrLf & "Status: " & stat & _  
                  "SQL: " & sql  
   End If
   
   ' Protkollierung Endezeitpunkt der Verarbeitung  
   'Debug.Print "ende CQI Verarbeitung : " & Format(Now, "hh:nn:ss")  
      
   ' Messung : Dauer Senden HTTP-Request zu Empfangen HTTP-Response  
   'Debug.Print "Zeitdauer Senden der Anforderung - Antwort vom Server : " & objCQI.LastReqRespDuration  
            
   ' Objektvariable zerstören  
   Set objCQI = Nothing
   
End Sub

Public Sub TEST1() ' As Long  
   
   Dim objCQI As cqi
   'Login übernehmen  
   Login objCQI
   'löschen der alten Daten  
    Sheets("TEST1").Select  
    Cells.Select
    Selection.ClearContents
  
   Dim sql As String, tblname As String, Server As String
   
   sql = "select * from TEST1"  
        
 
   tblname = "TEST1"  
   
   ' Protkollierung Startzeitpunkt der Verarbeitung  
   'Debug.Print "start CQI Verarbeitung : " & Format(Now, "hh:nn:ss")  
       
   Dim resultOfAction As String
   
   Dim stat As RETCODE
   ' Absetzen der Query  
   stat = objCQI.DoRequest4XL(ActiveWorkbook.ActiveSheet, sql, tblname, resultOfAction)
   If stat <> RETCODE.ok Then
   '   Debug.Print "Fehler bei HTTP-Request:" & vbCrLf & resultOfAction & vbCrLf & "Status: " & stat & _  
                  "SQL: " & sql  
   End If
   
   ' Protkollierung Endezeitpunkt der Verarbeitung  
   'Debug.Print "ende CQI Verarbeitung : " & Format(Now, "hh:nn:ss")  
      
   ' Messung : Dauer Senden HTTP-Request zu Empfangen HTTP-Response  
   'Debug.Print "Zeitdauer Senden der Anforderung - Antwort vom Server : " & objCQI.LastReqRespDuration  
            
   ' Objektvariable zerstören  
   Set objCQI = Nothing
   
End Sub

Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben

Content-ID: 245816

Url: https://administrator.de/contentid/245816

Ausgedruckt am: 23.11.2024 um 03:11 Uhr

3 Kommentare

Neuester Kommentar

Moin karlchristian,
das waren für meinen Geschmack zu viele Public und Functions in deiner wirren Beschreibung

Aber so wie ich das interpretiert habe, möchtest du einfach für alle Datenbanknamen die jetzt in meinem Beispiel im ersten Arbeitsblatt ab Zelle A1 alle untereinander stehen, jeweils ein Blatt erzeugen (falls es nicht existiert) und dann dafür deine Funktion ausführen. dazu brauchst du keine weiteren Funktionen erstellen (was übrigens auch nicht funktionieren würde), sondern gibst einer einizigen Funktion das entsprechende Worksheet als Parameter mit.

Sub Daten_laden()
    Dim ws1 As Worksheet, cell As Range
    Set ws1 = Worksheets(1)
    For Each cell In ws1.Range("A1", ws1.Range("A1").End(xlDown))  
        On Error Resume Next
        If Worksheets(cell.Value) Is Nothing Then
            Worksheets.Add After:=Worksheets(Worksheets.Count)
            Worksheets(Worksheets.Count).Name = cell.Value
        End If
        TEST Worksheets(cell.Value)
    Next
End Sub


Public Sub TEST(ByVal ws As Worksheet) ' As Long  
   
   Dim objCQI As cqi
   'Login übernehmen  
   Login objCQI
   'löschen der alten Daten  
    ws.Select
    Cells.Select
    Selection.ClearContents
  
   Dim sql As String, tblname As String, Server As String
   tblname = ws.Name
   sql = "select * from " & tblname  

   ' Protkollierung Startzeitpunkt der Verarbeitung  
   'Debug.Print "start CQI Verarbeitung : " & Format(Now, "hh:nn:ss")  
       
   Dim resultOfAction As String
   
   Dim stat As RETCODE
   ' Absetzen der Query  
   stat = objCQI.DoRequest4XL(ws, sql, tblname, resultOfAction)
   If stat <> RETCODE.ok Then
   '   Debug.Print "Fehler bei HTTP-Request:" & vbCrLf & resultOfAction & vbCrLf & "Status: " & stat & _  
                  "SQL: " & sql  
   End If
   
   ' Protkollierung Endezeitpunkt der Verarbeitung  
   'Debug.Print "ende CQI Verarbeitung : " & Format(Now, "hh:nn:ss")  
      
   ' Messung : Dauer Senden HTTP-Request zu Empfangen HTTP-Response  
   'Debug.Print "Zeitdauer Senden der Anforderung - Antwort vom Server : " & objCQI.LastReqRespDuration  
            
   ' Objektvariable zerstören  
   Set objCQI = Nothing
End Sub

Viel Erfolg
Grüße Uwe

Hallo Uwe,
danke für den Hinweis.

ich habe nur das Problem, dass er mir eine Tabelle Beispiel erzeugt, und eine Tabelle 1.2.3.4.... ect

beim erstmaligem ausführen des Skipts
habe ich bei Daten laden im Bereich

For Each cell In ws1.Range("A1", ws1.Range("A1").End(xlDown))  

das Wort Beispiel,
keine Ahnung woher er dieses zieht.
und versucht natürlich dann eine SQL Abfrage damit zu erzeugen.

Vielleicht kannst du hier nochmal schauen

In meinem Beispiel stehen deine Tabellennamen von Zelle "A1" abwärts untereinander bis die erste leere Zelle auftaucht auf dem ersten Tabellenblatt! Das funktioniert einwandfrei.

Aber mit deiner ziemlich besch. Erklärung wo deine Daten stehen, kann ich ja nicht Hellsehen !!! Also gib die nochmal mehr Mühe um es genauer verstehen zu können. Danke.

Frage Microsoft Microsoft Office

Mehr von karlchristian

Aus SQL Abfrage Ergebnis in Variable per loop schreibenkarlchristian - 4 Kommentare

Registersteuerelement Beschriftung per VBA ändern Access 2010karlchristian - 1 Kommentar

ACCESS 2010 DLookup auf eine Temp Tabelle machen.karlchristian - 5 Kommentare

Probleme beim öffnen von Formulare über Registersteuerelemente Laufzeitfehler 2465 Access 2010karlchristian - 1 Kommentar

Heiß diskutiert