pistensau
Jun 23, 2023
view1499
view9
0
Goto Top

VBA - Code hat einen Wurm drin

GermansolvedQuestionVB for Applications
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 face-wink

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
comment-contentCommentShareShare
Share on Facebook Share on Twitter Share on Reddit Share on Linkedin

Content-Key: 7626531484

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

Printed on: April 28, 2024 at 11:04 o'clock

9 Comments
Latest comment
Goto Top
Member: Kraemer
Kraemer Jun 23, 2023 at 10:44:22 (UTC)
Goto Top
Dim i, letzteZeile As String
imho wäre Integer hier der richtige Typ
heart1
Member: Pistensau
Pistensau Jun 23, 2023 at 11:48:23 (UTC)
Goto Top
Ja, diese Version hatte ich auch schon, jedoch ohne Erfolg. Typen unverträglich bleibt bestehen!
Trotzdem danke dir für diese Idee
Member: Kraemer
Kraemer Jun 23, 2023 at 12:02:59 (UTC)
Goto Top
Da fehlen auch noch dutzende "
Zeigt dir dein Editor die Zeilen nicht in rot an?

guck mal in der Nähe von {backslashDoublequote}
Member: Pistensau
Pistensau Jun 23, 2023 at 12:14:16 (UTC)
Goto Top
Ich kann da jetzt keinen Fehler erkennen... Kannst du eine Zeile aus dem Code einfügen bitte
Member: Kraemer
Kraemer Jun 23, 2023 at 12:38:45 (UTC)
Goto Top
Zitat von @Pistensau:

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
Member: Pistensau
Pistensau Jun 23, 2023 at 13:14:34 (UTC)
Goto Top
Ich kann da jetzt keinen Fehler erkennen... Kannst du eine Zeile aus dem Code einfügen bitte
Zitat von @Kraemer:

Zitat von @Pistensau:

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

VBA markiert mir diese Zeile:

If Cells(i, 1).Value <> "" Then

Jedoch kann ich da nun überhaupt keinen Fehler erkennen...
Mitglied: 7426148943
7426148943 Jun 23, 2023 updated at 13:32:59 (UTC)
Goto Top
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
Member: Frank
Frank Jun 23, 2023 at 17:05:56 (UTC)
Goto Top
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}

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
heart2
Member: Frank
Frank Jul 04, 2023 updated at 21:34:03 (UTC)
Goto Top
Okay,

der Fehler in unserem Code-Parser ist behoben. Dieser Quellcode war wirklich eine Herausforderung für unsere Erkennung.

Ich hoffe, das eigentliche Problem des Autors konnte gelöst werden. Sorry nochmal, das der Quellcode von uns falsch angezeigt wurde.

Gruß
Frank
heart1
GermansolvedQuestionVB for Applications
Hotly discussed
admtechDeveloper diary: Release 6.1admtechDaniEnd of availability for classic Teams clientDani