Hallo BigBen,

dank deines letzten Codes in der Nachricht vom 08.04.2017 habe es nun geschafft. Das mit dem GetChunk-Befehl hat auch wunderbar funktioniert. Unten habe ich meinen Code nochmals aufgeführt für andere Anwender die etwas ähnliches machen möchten.  Ich hab den Code noch erweitert, sodass die Schildnummer und die Sprache aus dem Excel-Arbeitsblatt kommen. Über den Autofilter wir die Liste reduziert und nur die sichtbaren Zeilen werden verwertet. Außerdem habe ich noch eine If-Abfrage intergriert, da manche Schilder mehrfach vom SQL-Server abgefragt werden sollen im Falle das diese mehrfach in der Liste auftauchen. Außerdem gibt es in meinem Code noch einige Abfragen die sicherstellen das der SQL-Server immer eine Rückmeldung gibt und das der Bediener alles richtig macht. Ich denke das einige Dinge vielleicht andern weiterhelfen können.

Vielen Dank dir nochmals BigBen ohne dich wäre das nie was geworden.

Gruß

Dominik

Code-Teil 1:

Sub Anfragen_SQL_Server_nach_Auswahl()
  
    Dim Sprache As String
    Dim Nummer As String
    Dim i As Integer
    
If Sprache = "Sprachen auswählen" Then
    MsgBox ("Bitte Sprachen auswahlen")
    Exit Sub

Else
    
    For i = 6 To 102                                           'Beginnend in Zeile 6 bis 102 (je nachdem welche Zeilen für die Schilder verwendet werden)
        If Not Sheets("Tabelle1").Rows(i).Hidden = True Then   'Prüfen ob Zeile sichtbar oder durch Autofilter ausgeblendet
            Nummer = Sheets("Tabelle1").Range("D" & i).Value   'Nummer aus Zelle
            Sprache = Sheets("Tabelle1").Range("B1").Value     'Sprache aus Excel-Dropdown
            Call Bild_von_SQL_Server(Sprache, Nummer)
        End If
    
    Next

End If

End Sub

Code-Teil 2 (Unterprogramm):

Sub Bild_von_SQL_Server(Sprache As String, Nummer As String) 'Code von https://social.msdn.microsoft.com/Forums/de-DE/a73a838b-ec3f-419b-be65-8b1732fbf4d0/connect-to-a-remote-sql-server-db?forum=isvvba

    Dim Cn As New ADODB.Connection
    Dim Server_Name As String
    Dim Database_Name As String
    Dim User_ID As String
    Dim Password As String
    Dim SQLStr As String
    Dim rs As New ADODB.Recordset
    Dim strFilename As String
    Dim iFile As Integer
    Dim i2 As Integer
    Dim i3 As String
    Dim arrPicture() As Byte, lSize As Long
    Dim Speicherort As String
    
    Set rs = New ADODB.Recordset
    Set Cn = New ADODB.Connection
    Speicherort = Sheets("Tabelle1").Range("B3").Value

    Server_Name = "Server_XYZ"                        ' Servername hier eingeben
    Database_Name = "Schilder"                        ' Datenbankname hier eingeben
    User_ID = "XXX"                          ' User_ID hier eingeben
    Password = "abc"                                  ' Passwort hier eingeben
    SQLStr = "SELECT Schilder.SVG as Bild " & _
            "FROM Sprachen INNER JOIN Schilder ON Sprachen.ID = Schilder.SprachenID" & _
            " WHERE (Sprachen.Sprache = N'" + Sprache + "') AND (Schilder.MasterID = '" + Nummer + "')"
        Cn.Open "Driver={SQL Server};Server=" & Server_Name & ";Database=" & Database_Name & ";user id=" & User_ID & ";pwd=" & Password & ";"
        'Debug.Print SQLStr                                 'SQL-String in Direktfenster anzeigen
    
        rs.Open SQLStr, Cn, adOpenStatic
    
        ' Auslesen des Bildes
        If Not rs.EOF Then
            lSize = rs.Fields("Bild").ActualSize
            ReDim arrPicture(lSize)
            arrPicture = rs.Fields("Bild").GetChunk(lSize)  ' Testen, ob dieser Befehl geeignet ist

            ' Schreiben des Bildes
            iFile = FreeFile()
            If Dir(Speicherort + Nummer + Sprache + ".svg") <> "" Then                          'Prüfen ob erste Datei bereits vorhanden
                If Dir(Speicherort + Nummer + Sprache + "(2)" + ".svg") <> "" Then              'Prüfen ob zweite Datei bereits vorhanden
                    i2 = 3
                    Do
                    i3 = CStr(i2)
                    If Dir(Speicherort + Nummer + Sprache + "(" + i3 + ")" + ".svg") <> "" Then 'Prüfen ob dritte bzw. jede weitere Datei bereits vorhanden
                      i2 = i2 + 1
                    
                    Else
                        strFilename = Speicherort + Nummer + Sprache + "(" + i3 + ")" + ".svg"  'Schreiben der dritten Datei bzw. jeder weiteren
                        Open strFilename For Binary As #iFile
                            Put #iFile, , arrPicture
                            Close #iFile
                        Exit Do
                    End If
                    Loop

                    
                Else                                                                             'Schreiben der zweiten Datei falls nicht bereits vorhanden
                    strFilename = Speicherort + Nummer + Sprache + "(2)" + ".svg"
                    Open strFilename For Binary As #iFile
                        Put #iFile, , arrPicture
                        Close #iFile
                End If
            Else                                                                                 'Schreiben der erste Datei falls nicht bereits vorhanden
                strFilename = Speicherort + Nummer + Sprache + ".svg"
                Open strFilename For Binary As #iFile
                    Put #iFile, , arrPicture
                    Close #iFile
            End If
            
        Else
            MsgBox ("Datei " + Nummer + Sprache + " konnte nicht in der gewünschten Sprache gefunden werden! Bitte diese Nummer notieren und Schild entsprechend erstellen und anlegen lassen!")
            
        End If
        
        'Alles aufräumen und schließen
        rs.Close
        Set rs = Nothing
        Cn.Close
        Set Cn = Nothing

End Sub