VBA - Code hat einen Wurm drin
Hallo Forumsgemeinde,
ich wende mich an euch mit einem klassischen Problem in VBA...
Laufzeitfehler '13': Typen unverträglich
Ich bin den Code schon Zeile für Zeile durchgegangen und kann den/die Fehler nicht finden und hoffe auf eure Augen...
Was macht der Code, oder was soll er machen:
In der Tabelle ab A2 stehen 8stellige Zahlen (sku) und es soll geschaut werden ob sich in einem bestimmten Ordner Bilder befinden, die bestimmte Kriterien im Namen enthalten. Findet Excel den Namen soll es einen entsprechenden Text in die entsprechende Zeile eintragen. Vielleicht findet sich ein Profi (ich bin es nicht) in VBA und kann da einen Blick drauf werfen, mein Dank wäre ihm gewiss.
Allen anderen viel spaß beim coden
ich wende mich an euch mit einem klassischen Problem in VBA...
Laufzeitfehler '13': Typen unverträglich
Ich bin den Code schon Zeile für Zeile durchgegangen und kann den/die Fehler nicht finden und hoffe auf eure Augen...
Was macht der Code, oder was soll er machen:
In der Tabelle ab A2 stehen 8stellige Zahlen (sku) und es soll geschaut werden ob sich in einem bestimmten Ordner Bilder befinden, die bestimmte Kriterien im Namen enthalten. Findet Excel den Namen soll es einen entsprechenden Text in die entsprechende Zeile eintragen. Vielleicht findet sich ein Profi (ich bin es nicht) in VBA und kann da einen Blick drauf werfen, mein Dank wäre ihm gewiss.
Allen anderen viel spaß beim coden
Sub DateiSuchen_ohne_Archiv_II()
'
' DateiSuchen_ohne_Archiv_II Makro
'
'Überschriften in Zeile 1 farblich markieren
Range("A1").Interior.ColorIndex = 15
Range("B1:C1").Interior.ColorIndex = 19
Range("D1:O1").Interior.ColorIndex = 20
Range("P1:Q1").Interior.ColorIndex = 22
Range("R1:AC1").Interior.ColorIndex = 24
'Überschriften in Zeile 1 schreiben
Range("A1").Value = "sku"
Range("B1").Value = "feature_images_attribute"
Range("C1").Value = "feature_images_attribute-file_path"
Range("D1").Value = "product_images_de"
Range("E1").Value = "product_images_de-file_path"
Range("F1").Value = "product_images_es"
Range("G1").Value = "product_images_es-file_path"
Range("H1").Value = "product_images_fr"
Range("I1").Value = "product_images_fr-file_path"
Range("J1").Value = "product_images_it"
Range("K1").Value = "product_images_it-file_path"
Range("L1").Value = "product_images_uk"
Range("M1").Value = "product_images_uk-file_path"
Range("N1").Value = "product_images_yy"
Range("O1").Value = "product_images_yy-file_path"
Range("P1").Value = "plain_images"
Range("Q1").Value = "plain_images-file_path"
Range("R1").Value = "productpassion_de"
Range("S1").Value = "productpassion_de-file_path"
Range("T1").Value = "productpassion_es"
Range("U1").Value = "productpassion_es-file_path"
Range("V1").Value = "productpassion_fr"
Range("W1").Value = "productpassion_fr-file_path"
Range("X1").Value = "productpassion_it"
Range("Y1").Value = "productpassion_it-file_path"
Range("Z1").Value = "productpassion_uk"
Range("AA1").Value = "productpassion_uk-file_path"
Range("AB1").Value = "productpassion_yy"
Range("AC1").Value = "productpassion_yy-file_path"
' Zeilenumbruch in den Überschriften generieren
Range("A1:AC1").WrapText = True
' -------------------------------------------------------------
Dim sku As String
Dim laufwerk As String
Dim i, letzteZeile As String
Dim j, X, G As Integer
Dim strDimensions, titel, strFeature As String
Dim strLogo_yy, strLogo_de, strLogo_es, strLogo_fr, strLogo_it, strLogo_uk As String
Dim strUsp_yy, strUsp_de, strUsp_es, strUsp_fr, strUsp_it, strUsp_uk As String
Dim yy, de, es, fr, it, uk As String
Dim yy_path, de_path, es_path, fr_path, it_path, uk_path As String
Dim plain, plain_path As String
Dim pp_yy, pp_de, pp_es, pp_fr, pp_it, pp_uk As String
Dim pp_yy_path, pp_de_path, pp_es_path, pp_fr_path, pp_it_path, pp_uk_path As String
Dim feat, feat_path As String
' Array deklaration
Dim strPaths(2 To 12, 1 To 7), dimensions(2 To 12, 1 To 7), lang(1 To 6) As String
lang(1) = "yy"
lang(2) = "de"
lang(3) = "es"
lang(4) = "fr"
lang(5) = "it"
lang(6) = "uk"
Dim strPaths_PP(2 To 12, 1 To 7), strPlain_yy(1 To 12) As String
'Ermitteln letzter Zeile mit sku
letzteZeile = Cells(Rows.Count, 1).End(xlUp).Row
'Ermitteln der Quelle im Tabellenblatt_2
laufwerk = Worksheets("Tabelle2").Range("A1").Value
' Schleife über alle SKUs
For i = 2 To letzteZeile
If Cells(i, 1).Value <> "" Then
sku = Cells(i, 1).Value
' Suchen nach titel
titel = laufwerk & sku & "\01_Bilder\1500\" & sku & "_yy_0001_titel___.jpg"
If Dir(titel) <> "" Then
If yy = "" Then
yy = sku & "_yy_0001_titel___"
yy_path = "file/" & sku & "/product_images_yy/" & sku & "_yy_0001_titel___"
Else
yy = yy & "," & sku & "_yy_0001_titel___"
yy_path = yy_path & ",file/" & sku & "/product_images_yy/" & sku & "_yy_0001_titel___"
End If
End If
' Suche nach logo und table in Global USPs und allen Sprachen
For X = 2 To 10
For j = 1 To 7
If j = 1 Then
strLogo = laufwerk & sku & "\01_Bilder\1500\" & sku & "_" & lang(j) & "_000" & X & "_logo___.jpg"
Else
strLogo = laufwerk & sku & "\01_Bilder\1500\" & UCase(lang(j)) & "\" & sku & "_" & lang(j) & "_000" & X & "_logo___.jpg"
End If
If Dir(strLogo) <> "" Then
If X < 10 Then
If yy <> "" Then
yy = sku & "_" & lang(j) & "_000" & X & "_logo___"
yy_path = "file/" & sku & "/product_images_yy/" & sku & "_" & lang(j) & "_000" & X & "_logo___"
Else
yy = yy + "," & sku & "_" & lang(j) & "_000" & X & "_logo___"
yy_path = yy_path + "," & "file/" & sku & "/product_images_yy/" & sku & "_" & lang(j) & "_000" & X & "_logo___"
End If
Else
If yy <> "" Then
yy = sku & "_" & lang(j) & "_00" & X & "_logo___"
yy_path = "file/" & sku & "/product_images_yy/" & sku & "_" & lang(j) & "_00" & X & "_logo___"
Else
yy = yy + "," & sku & "_" & lang(j) & "_00" & X & "_logo___"
yy_path = yy_path + "," & "file/" & sku & "/product_images_yy/" & sku & "_" & lang(j) & "_00" & X & "_logo___"
End If
End If
End If
If j = 1 Then
strTable = ""
Else
strTable = laufwerk & sku & "\01_Bilder\1500\" & UCase(lang(j)) & "\" & sku & "_YY_0012_table___.jpg"
End If
If Dir(strTable) <> "" Then
If yy <> "" Then
yy = sku & "_" & lang(j) & "_0012_table___"
yy_path = "file/" & sku & "/product_images_yy/" & sku & "_" & lang(j) & "_0012_table___"
Else
yy = yy + "," & sku & "_" & lang(j) & "_0012_table___"
yy_path = yy_path + "," & "file/" & sku & "/product_images_yy/" & sku & "_" & lang(j) & "_0012_table___"
End If
End If
Next j
Next X
'Suchen nach dimensions in global
If Dir(laufwerk & sku & "\01_Bilder\1500\" & sku & "_yy_0011_dimensions___.jpg") <> "" Then
If yy <> "" Then
yy = sku & "_yy_0011_dimensions___"
yy_path = "file/" & sku & "/product_images_yy/" & sku & "_yy_0011_dimensions___"
Else
yy = yy + "," & sku & "_yy_0011_dimensions___"
yy_path = yy_path + "," & "file/" & sku & "/product_images_yy/" & sku & "_yy_0011_dimensions___"
End If
End If
' -------------------------------------------------------------------------------------
'
' PRODUCT PASSION
' Suchen nach main in yy
main = laufwerk & sku & "\01_Bilder\1500\AMZ\" & sku & "_yy_0001_main___.jpg"
If Dir(main) <> "" Then
If (pp_yy) = "" Then
pp_yy = sku & "_yy_0001_main___"
pp_yy_path = "file/" & sku & "/productpassion_yy/" & sku & "_yy_0001_main___"
Else
pp_yy = pp_yy + "," & sku & "_yy_0001_main___"
pp_yy_path = pp_yy_path + ",file/" & sku & "/productpassion_yy/" & sku & "_yy_0001_main___"
End If
End If
' Suchen nach mainfallback in yy
mainfallback = laufwerk & sku & "\01_Bilder\1500\AMZ\" & sku & "_yy_0001_mainfallback___.jpg"
If Dir(mainfallback) <> "" Then
If (pp_yy) = "" Then
pp_yy = sku & "_yy_0001_mainfallback___"
pp_yy_path = "file/" & sku & "/productpassion_yy/" & sku & "_yy_0001_mainfallback___"
Else
pp_yy = pp_yy + "," & sku & "_yy_0001_mainfallback___"
pp_yy_path = pp_yy_path + ",file/" & sku & "/productpassion_yy/" & sku & "_yy_0001_mainfallback___"
End If
End If
' Suchen nach thumb in yy
thumb = laufwerk & sku & "\01_Bilder\1500\AMZ\" & sku & "_yy_0100_thumb___.jpg"
If Dir(thumb) <> "" Then
If (pp_yy) = "" Then
pp_yy = sku & "_yy_0100_thumb___"
pp_yy_path = "file/" & sku & "/productpassion_yy/" & sku & "_yy_0100_thumb___"
Else
pp_yy = pp_yy + "," & sku & "_yy_0100_thumb___"
pp_yy_path = pp_yy_path + ",file/" & sku & "/productpassion_yy/" & sku & "_yy_0100_thumb___"
End If
End If
' Suche nach plain in AMZ\Plain
Dim strPlain As Variant
For j = 1 To 12
If j < 10 Then
strPlain = laufwerk & sku & "\01_Bilder\1500\AMZ\Plain\" & sku & "_yy_000" & j & "_plain___.jpg"
If Dir(strPlain(j)) <> "" Then
If (plain = "") Then
plain = sku + "_yy_000" & j & "_plain___"
plain_path = "file/" & sku & "/plain_images/" & sku & "_yy_000" & j & "_plain___"
Else
plain = sku + "_yy_000" & j & "_plain___"
plain_path = "file/" & sku & "/plain_images/" & sku & "_yy_000" & j & "_plain___"
End If
End If
Else
If (plain = "") Then
plain = sku + "_yy_00" & j & "_plain___"
plain_path = "file/" & sku & "/plain_images/" & sku & "_yy_00" & j & "_plain___"
Else
plain = sku + "_yy_00" & j & "_plain___"
plain_path = "file/" & sku & "/plain_images/" & sku & "_yy_00" & j & "_plain___"
End If
End If
Next j
'Suche nach main und usp in yy, de, es, fr, it, uk
For X = 1 To 12
For j = 1 To 6
strMain = laufwerk & sku & "\01_Bilder\1500\AMZ\" & UCase(lang(j)) & "\" & sku & "_" & lang(j) & "_0001_main___.jpg"
If Dir(strMain) <> "" Then
If pp_yy = "" Then
pp_yy = sku & "_" & lang(j) & "_0001_main___"
pp_yy_path = "file/" & sku & "/product_images_yy/" & sku & "_" & lang(j) & "_0001_main___"
Else
pp_yy = pp_yy + "," & sku & "_" & lang(j) & "_0001_main___"
pp_yy_path = pp_yy_path + ",file/" & sku & "/product_images_yy/" & sku & "_" & lang(j) & "_0001_main___"
End If
End If
strUsp = laufwerk & sku & "\01_Bilder\1500\AMZ\" & UCase(lang(j)) & "\" & sku & "_" & lang(j) & "_000" & X & "_usp___.jpg"
If Dir(strUsp) <> "" Then
If X < 10 Then
If pp_yy = "" Then
pp_yy = sku & "_" & lang(j) & "_000" & X & "_usp___"
pp_yy_path = "file/" & sku & "/product_images_yy/" & sku & "_" & lang(j) & "_000" & X & "_usp___"
Else
pp_yy = pp_yy + "," & sku & "_" & lang(j) & "_000" & X & "_usp___"
pp_yy_path = pp_yy_path + ",file/" & sku & "/product_images_yy/" & sku & "_" & lang(j) & "_000" & X & "_usp___"
End If
Else
If pp_yy = "" Then
pp_yy = sku & "_" & lang(j) & "_00" & X & "_usp___"
pp_yy_path = "file/" & sku & "/product_images_yy/" & sku & "_" & lang(j) & "_00" & X & "_usp___"
Else
pp_yy = pp_yy + "," & sku & "_" & lang(j) & "_00" & X & "_usp___"
pp_yy_path = pp_yy_path + ",file/" & sku & "/product_images_yy/" & sku & "_" & lang(j) & "_00" & X & "_usp___"
End If
End If
End If
Next j
Next X
' -------------------------------------------------------------------------------------
'
' FEATURE IMAGES
For G = 1 To 3
If Dir(laufwerk & sku & "\01_Bilder\Feature\" & sku & "_yy_000" & G & "_feature___.jpg") <> "" Then
strFeature = laufwerk & sku & "\01_Bilder\Feature\" & sku & "_yy_000" & G & "_feature___.jpg"
ElseIf Dir(laufwerk & sku & "\01_Bilder\Features\1500\" & sku & "_yy_000" & G & "_feature___.jpg") <> "" Then
strFeature = laufwerk & sku & "\01_Bilder\Features\1500\" & sku & "_yy_000" & G & "_feature___.jpg"
ElseIf Dir(laufwerk & sku & "\01_Bilder\1500\Features\" & sku & "_yy_000" & G & "_feature___.jpg") <> "" Then
strFeature = laufwerk & sku & "\01_Bilder\1500\Features\" & sku & "_yy_000" & G & "_feature___.jpg"
ElseIf Dir(laufwerk & sku & "\01_Bilder\1500\Features\1500\" & sku & "_yy_000" & G & "_feature___.jpg") <> "" Then
strFeature = laufwerk & sku & "\01_Bilder\1500\Features\1500\" & sku & "_yy_000" & G & "_feature___.jpg"
Else
strFeature = ""
End If
If strFeature <> "" Then
If feat = "" Then
feat = sku & "_yy_000" & G & "_feature___"
feat_path = "file/" & sku & "/feature_images_attribute/" & sku & "_yy_000" & G & "_feature___"
Else
feat = feat & "," & sku & "_yy_000" & G & "_feature___"
feat_path = feat_path & ",file/" & sku & "/feature_images_attribute/" & sku & "_yy_000" & G & "_feature___"
End If
End If
Next G
' Ausgabe in die Tabelle
With Cells(i, 2)
.Value = feat
.WrapText = True
End With
With Cells(i, 3)
.Value = feat_path
.WrapText = True
End With
With Cells(i, 4)
.Value = de
.WrapText = True
End With
With Cells(i, 5)
.Value = de_path
.WrapText = True
End With
With Cells(i, 6)
.Value = es
.WrapText = True
End With
With Cells(i, 7)
.Value = es_path
.WrapText = True
End With
With Cells(i, 8)
.Value = fr
.WrapText = True
End With
With Cells(i, 9)
.Value = fr_path
.WrapText = True
End With
With Cells(i, 10)
.Value = it
.WrapText = True
End With
With Cells(i, 11)
.Value = it_path
.WrapText = True
End With
With Cells(i, 12)
.Value = uk
.WrapText = True
End With
With Cells(i, 13)
.Value = uk_path
.WrapText = True
End With
With Cells(i, 14)
.Value = yy
.WrapText = True
End With
With Cells(i, 15)
.Value = yy_path
.WrapText = True
End With
With Cells(i, 16)
.Value = plain
.WrapText = True
End With
With Cells(i, 17)
.Value = plain_path
.WrapText = True
End With
With Cells(i, 18)
.Value = pp_de
.WrapText = True
End With
With Cells(i, 19)
.Value = pp_de_path
.WrapText = True
End With
With Cells(i, 20)
.Value = pp_es
.WrapText = True
End With
With Cells(i, 21)
.Value = pp_es_path
.WrapText = True
End With
With Cells(i, 22)
.Value = pp_fr
.WrapText = True
End With
With Cells(i, 23)
.Value = pp_fr_path
.WrapText = True
End With
With Cells(i, 24)
.Value = pp_it
.WrapText = True
End With
With Cells(i, 25)
.Value = pp_it_path
.WrapText = True
End With
With Cells(i, 26)
.Value = pp_uk
.WrapText = True
End With
With Cells(i, 27)
.Value = pp_uk_path
.WrapText = True
End With
With Cells(i, 28)
.Value = pp_yy
.WrapText = True
End With
With Cells(i, 29)
.Value = pp_yy_path
.WrapText = True
End With
Cells(i, 1).RowHeight = 20
End If
feat = ""
feat_path = ""
de = ""
de_path = ""
es = ""
es_path = ""
fr = ""
fr_path = ""
it = ""
it_path = ""
uk = ""
uk_path = ""
yy = ""
yy_path = ""
plain = ""
plain_path = ""
pp_de = ""
pp_de_path = ""
pp_es = ""
pp_es_path = ""
pp_fr = ""
pp_fr_path = ""
pp_it = ""
pp_it_path = ""
pp_uk = ""
pp_uk_path = ""
pp_yy = ""
pp_yy_path = ""
Next i
End Sub
Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben
Content-ID: 7626531484
Url: https://administrator.de/forum/vba-code-hat-einen-wurm-drin-7626531484.html
Ausgedruckt am: 14.03.2025 um 10:03 Uhr
9 Kommentare
Neuester Kommentar
Zitat von @Pistensau:
Ich kann da jetzt keinen Fehler erkennen... Kannst du eine Zeile aus dem Code einfügen bitte
Ich kann da jetzt keinen Fehler erkennen... Kannst du eine Zeile aus dem Code einfügen bitte
sorry - ist gar nicht in deinem Code - wird hier nur falsch angezeigt
Was du machen musst ist eigentlich ganz einfach:
Geh in dein VBA-Modul und debugge das. Mit F8 gehst du Zeile für Zeile durch den Code, und wenn da dann ein Fehler auftaucht, kommst du entweder selbst drauf oder postest die Zeile dann hier

Du hast da offensichtlich ein Verständnisproblem was die Typendeklaration der Variablen betrifft, es reicht nicht den Typ am Ende einer reihe von mehreren Variablen festzulegen, dies muss für jede Variable einzeln geschehen, ansonsten ist nur die letzte in der Reihe von diesem Typ und alle anderen nehmen erheblich mehr Speicher in Anspruch das dessen Typ intern als "Object" vorhgenommen wird ! Des weiteren ist wie schon genannt wurde die Deklaration einer Integer Variablen als String problematisch und genau das sagt dir an dieser Stelle der Interpreter.
Zeppel
Zeppel
Zitat von @Kraemer:
Da fehlen auch noch dutzende "
Zeigt dir dein Editor die Zeilen nicht in rot an?
guck mal in der Nähe von {backslashDoublequote}
Da fehlen auch noch dutzende "
Zeigt dir dein Editor die Zeilen nicht in rot an?
guck mal in der Nähe von {backslashDoublequote}
Das mit dem "backslashDoublequote" ist ein Fehler in unserer Textformatierung in den Code-Blöcken. Sorry, ich schau mir den Fehler die Tage and und löse ihn.
Gruß
Frank
Webmaster