Hier mal ein Lösungsansatz noch ohne Schleife für den einen Beispielsatz:

Sub test()
Sub test()
ChDir "U:\GROSSER\BILDER\"
Bild = Dir("EXO360020.jpg")
If Bild = "" Then
    'noimage
Else
    FileSystemObject.CopyFile "drachen800.jpg", _
    "U:\Projekte\Websites\_ZooZemke\Cart\"
End If

End Sub

In den IF-Zweig muss natürlich nochwas rein. Da habe ich aber nicht genau verstanden, was du willst.
Dann muss das Ganze noch in eine Schleife gepackt werden, die alle Zeilen abklappert. Da kenne ich mich aber nicht so gut aus.

Gruß Flupo

Erst einmal Danke, aber das hilft nicht so ganz, da hier der Dateiname definiert werden muss.

Hier mal mein Lösungsansatz mit Hilfspalte, aber ich habe da ein Problem, wo ich nicht weiter komme:
(strQuelle und strZiel haben nur andere Pfadeintragungen, die so I.O sind)

Sub test1()
' Hilsspalte anlegen und kopieren
Columns("D:D").Select
Selection.Copy
Columns("F:F").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.Replace What:="U:\Projekte\Websites\_ZooZemke\Cart\", Replacement _
:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
SearchFormat:=False, ReplaceFormat:=False

'Dateivergleich und Dateien kopieren
Dim strQuelle As String
Dim strZiel As String
strQuelle = "U:\Grosser\Bilder\Monacor\" & ActiveCell
strZiel = "U:\Projekte\Websites\_Grosser\Cart\" & ActiveCell
Range("F2").Select
If "strDatei" = "strQuelle" Then 'HIER GIBTS MEIN DATEINAMEN-VERGLEICHSPROBLEM
FileCopy strQuelle, strZiel
Else: ActiveCell = "_NoImage.jpg"
End If

'AB HIER DIE NÄCHSTE ZEILE, KEINE IDEE

End Sub

Was kann besser, was muss korrigiert werden, was muss ergänzt werden?
Bitte Hilfe.

Nun habe ich den Code hin der auch funktioniert.

Wie bekomme ich das nun in eine Schleife, so dass Zelle für Zelle in Spalte F abgeklappert wird:

Sub test2()
Range("F1").Select
Dim strDatei As Variant
Dim strQuelle As String
Dim strZiel As String
strDatei = ActiveCell
strQuelle = "U:\Grosser\Bilder\Monacor\" & strDatei
strZiel = "U:\Projekte\Websites\_Grosser\Cart\" & strDatei
If Dir("U:\Grosser\Bilder\Monacor\" & strDatei) = "" Then
ActiveCell = "_NoImage.jpg"
Else
FileCopy strQuelle, strZiel
End If
End Sub

Mario

Hi,

@little-key
Auch wenn Du mit wechselnden und auch unklaren Anforderungen um die Ecke kommst, wollt ich doch malSchauen, ob ich das in Code umsetzen kann.

Wechslende Anforderungen?

• In der Frage stand etwas von einem Verzeichnis (U:\GROSSER\BILDER\). In #2 taucht nun aber schon ein Unterverzeichnis auf (U:\Grosser\Bilder\Monacor\). Heisst das, dass Unterverzeichnisse von "U:\GROSSER\BILDER\" mit durchsucht werden sollen?
  
• In der Frage stand der komplette Pfad zur Datei in Spalte "D". In #2 haben wir nun schon eine zusätzliche Spalte mit dem extrahierten Dateinamen.
  

Unklar?

• Hat die Spalte "D" eine Überschrift die nicht zu berücksichtigen ist?
  
• Ist Spalte "D" lückenlos gefüllt?
  
• Existieren die Pfade aus "D" komplett? Oder soll das der Code mit erledigen?
  
• Was soll bei "Nichtfinden" mit der _noimage.jpg passieren? Ich hab es einfach nicht durchschaut. (Wenn die Datei (z.B. EXO360020.jpg) in \Bilder.. nicht vorhanden ist, kann sie nicht ins Ziel kopiert und somit auch nicht umbenannt werden.)

Und zu guter Letzt ist es auch noch dringend? Mit dieser Aufgabe und diesen unklaren Anforderungen in einem Forum von Freiwilligen? Wenn es denn wirklich so dringend sein sollte, dann wirst Du wohl mehr üben, oder das Ganze als Auftragsprogrammierung vergeben müssen. ;-)

Sei es drum. Ich hab mal versucht das Ganze umzusetzen. Allerdings mehr oder weniger nach "meinen" Anforderungen, so wie ich sie mir aus Deinen Schilderungen zusammengereimt habe.

• Unterverzeichnisse von \Bilder werden mit durchsucht.
  
• leere Zeilen und fehlerhafte Pfadangaben in "D" habe ich versucht abzufangen
  
• die in "D" eingetragenen korrekten Pfade werden, wenn sie noch nicht vorhanden sind und wenn möglich, automatisch angelegt. (Also Obacht, was da so in Spalte "D" eingetragen wird.)
  
• es muss in \Bilder (oder einem beliebigen Unterverzeichnis) eine Datei vorhanden sein, die man beim "NichtFinden" ins Ziel kopieren kann (Im folgenden Code "_NoImage.jpg")
  
• Im Fall des "Nichtfindens" wird die "_NoImage.jpg" ins Ziel kopiert und dann dort umbenannt als wenn sie vorhanden gewesen wäre. (z.B. zu EXO360020.jpg)
  
• die wahren Quellen der Dateien werden zum Abschluss in eine Spalte geschrieben (im folgenden Code wäre das die Spalte "F" ("F" deshalb, weil Du die in #2 als Hilfspalte benutzt hast.)

Der folgende Code gehört dann KOMPLETT in ein (neues) StandardModul. Konstanten im Sub A_Start sind Deinen Bedürfnissen anzupassen. Tests bitte an einer TestDatei und vorzugsweise mit KOPIEN der betroffenen Verzeichnisse.

Und BITTE: Wenn Du Code postest, den sich andere anschauen, durchdenken und evtl. anpassen sollen, dann benutze den CodeTag (Code-Button über dem Antwortfeld). Oder programmierst Du in der VBE auch komplett ohne Einrückungen?

bye
malSchauen

btw: Code folgt in gesonderter Antwort...

Hi,

Option Explicit
'Variablen
'=========
Private varFSArr As Variant

'Funktionen
'==========
Private Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" ( _
  ByVal DirPath As String) As Long

Sub A_Start()
'Konstanten
'==========
Const strSuchVerzC As String = "U:\GROSSER\BILDER\"             '<<<<<<<BilderVerzeichnis anpassen
Const strNoImage As String = "_NoImage.jpg"                     '<<<<<<<Name für NoImage anpassen
Const strTabelle As String = "Tabelle1"                         '<<<<<<<TabellenName anpassen
Const strSpalte As String = "D"                                 '<<<<<<<Spalte anpassen
Const lngStartZeile As Long = 2                                 '<<<<<<<Erste Zeile anpassen
Const strErgSpalte As String = "F"                              '<<<<<<<ErgebnisSpalte anpassen
'Variablen
'=========
Dim varArrD() As Variant
Dim varFSArr2() As Variant
Dim lngLRow As Long
Dim lngCount As Long, lngCount2 As Long
Dim strPathToNoImage As String
Dim strSuchVerz As String
'PublicVar=> varFSArr As Variant

    'Spalte in DateiArray
    '====================
    With ThisWorkbook.Worksheets(strTabelle)
        lngLRow = IIf(IsEmpty(.Range(strSpalte & .Rows.Count)), _
        .Range(strSpalte & .Rows.Count).End(xlUp).Row, .Rows.Count)                     'letzte Zeile ermitteln
        varArrD = .Range(strSpalte & lngStartZeile & ":" & strSpalte & lngLRow).Value   'Spalte in Array
        ReDim Preserve varArrD(1 To UBound(varArrD, 1), 1 To 4)                         '2.Dimension vergrössern
                                                                                        '(für Dat.Name, gefunden in...)
    End With
    
    'Dateinamen im DateiArray extrahieren
    '====================================
    For lngCount = 1 To UBound(varArrD, 1)                                              'Für Elemente der 1.Dimension
        'wenn "\" in ,1 vorhanden, finde "\" von rechts,
        'schreibe Dateiname in ,3 und reinen Pfad in ,2
        If Not VarType(varArrD(lngCount, 1)) = vbEmpty Then _
            If InStrRev(varArrD(lngCount, 1), "\", Len(varArrD(lngCount, 1))) Then _
                varArrD(lngCount, 3) = Right(varArrD(lngCount, 1), _
                Len(varArrD(lngCount, 1)) - InStrRev(varArrD(lngCount, 1), "\")): _
                varArrD(lngCount, 2) = Left(varArrD(lngCount, 1), _
                InStrRev(varArrD(lngCount, 1), "\"))
    Next lngCount
    
    'SuchVerz in FSArray abbilden
    '============================
    ReDim varFSArr(0)                                                                   'FSArray leeren
    strSuchVerz = strSuchVerzC                                                          'Suchverz. holen
    If Right(strSuchVerz, 1) <> "\" Then strSuchVerz = strSuchVerz & "\"                '"\" am Ende sichern
    SuchRoot (strSuchVerz)
    
    'Dateinamen ins FSArray2 extrahieren
    '====================================
    ReDim varFSArr2(UBound(varFSArr))                                                   'Grössen angleichen
    For lngCount = 1 To UBound(varFSArr)                                                'Für jedes Element
        'wenn "\" vorhanden, finde "\" von rechts, schreibe Dateiname in FSArray2
        If InStrRev(varFSArr(lngCount), "\", Len(varFSArr(lngCount))) Then _
            varFSArr2(lngCount) = Right(varFSArr(lngCount), _
            Len(varFSArr(lngCount)) - InStrRev(varFSArr(lngCount), "\"))
            'Pfad zu strNoImage herauspicken
            If LCase(varFSArr2(lngCount)) = LCase(strNoImage) Then strPathToNoImage = varFSArr(lngCount)
    Next lngCount
    'kein strNoImage=> Meldung und raus
    If strPathToNoImage = "" Then MsgBox "Datei " & strNoImage & _
                                        " nicht vorhanden!!!", vbCritical + vbOKOnly, "Fehler" _
                                        : End
    
    'DateiArray durchlaufen und mit
    'FSArray2 abgleichen und Quelle
    'in DateiArray notieren
    '==============================
    For lngCount = 1 To UBound(varArrD, 1)
        For lngCount2 = 1 To UBound(varFSArr2)
            If LCase(varArrD(lngCount, 3)) = LCase(varFSArr2(lngCount2)) Then
                varArrD(lngCount, 4) = varFSArr(lngCount2)
                Exit For
            Else                                                                        'Wenn kein Bild->
                varArrD(lngCount, 4) = strPathToNoImage                                 ' _noimage.jpg als Quelle
            End If
        Next lngCount2
    Next lngCount

    'DateiArray durchlaufen und Dateien kopieren
    'existiert ein Bild nicht im Suchverzeichnis
    'wird das _noimage.jpg mit dem gesuchtenNamen
    'im Ziel eingefügt
    '===========================================
    For lngCount = 1 To UBound(varArrD, 1)
        If VarType(varArrD(lngCount, 1)) = vbString And varArrD(lngCount, 1) Like "?:\*" _
            And Not (Mid(varArrD(lngCount, 1), 4) Like "*[/:*?<>|]*") Then
            'Sicherstellen, dass der Zielpfad existiert
            If MakeSureDirectoryPathExists(varArrD(lngCount, 1)) Then
                'Kopieren
                FileCopy varArrD(lngCount, 4), varArrD(lngCount, 1)
            End If
        Else
            varArrD(lngCount, 4) = ">>>!!!Fehler im Zielpfad!!!<<<"
        End If
    Next lngCount
    
    'Quellen aus DateiArray in nun
    'nutzloses FSArray2 um es am
    'Stück in die Ergebnisspalte
    'schieben zu können
    '=============================
    ReDim varFSArr2(1 To UBound(varArrD, 1), 1)
    For lngCount = 1 To UBound(varArrD, 1)
        varFSArr2(lngCount, 0) = varArrD(lngCount, 4)
    Next lngCount
    With ThisWorkbook.Worksheets(strTabelle)
        .Range(strErgSpalte & lngStartZeile).Resize(UBound(varFSArr2), 1) = varFSArr2
    End With
End Sub

Sub SuchRoot(strQuelle As String)
'Variablen
'=========
Dim objFS As Object
Dim fldQuelle As Object

    Set objFS = CreateObject("Scripting.FileSystemObject")
    Set fldQuelle = objFS.GetFolder(strQuelle)
        Verzeichnisse fldQuelle
    Set fldQuelle = Nothing
    Set objFS = Nothing
    
End Sub

Sub Verzeichnisse(objFld As Object)
'!!!Rekursiver Aufruf!!!
'aus "Sub SuchRoot" heraus angestossen

'Variablen
'=========
Dim objSubFld As Object
Dim objFile As Object
Dim objFS As Object

    Set objFS = CreateObject("Scripting.FileSystemObject")
    
    For Each objFile In objFld.Files
        ReDim Preserve varFSArr(UBound(varFSArr) + 1)
        varFSArr(UBound(varFSArr)) = objFile.Path
    Next objFile
    
    For Each objSubFld In objFld.SubFolders
        Verzeichnisse objSubFld
    Next

    Set objFS = Nothing
    Set objFld = Nothing
    Set objSubFld = Nothing
End Sub

bye
malSchauen

Danke für die Hilfe.
Wenn was unklar war/ist kann man ja nachfragen. So stand ich hilflos da.

Habe inzwischen folgende einfache Lösung gefunden:

Sub test2()
Dim strDatei As Variant
Dim strQuelle As String
Dim strZiel As String
Dim i, MAX As Integer
MAX = ActiveSheet.Cells(Rows.Count, 6).End(xlUp).Row
For i = 1 To MAX
Range("F" & i).Select
strDatei = ActiveCell
strQuelle = "U:\Grosser\Bilder\Monacor\" & strDatei
strZiel = "U:\Projekte\Websites\_Grosser\Cart\" & strDatei
If Dir("U:\Grosser\Bilder\Monacor\" & strDatei) = "" Then
ActiveCell = "_NoImage.jpg"
Else
FileCopy strQuelle, strZiel
End If
Next
End Sub

Herzlichen Dank an alle.

Wollte nun ein neues Thema eröffnen:

csv_datei einlesen, Spalte falsch formatiert

Aber das Forum erzählt mir: Keine doppelten Themen...., deshalb noch hier:

Mal ein ganz anderes Problem:

Eine Excel-Tabelle öffnet über ein Makro ein Fenster zur Auswahl

Private Sub Workbook_Open()
Pfad = "U:\Grosser\WWG\WWG_WSTA"
Shell "Explorer.exe " & Pfad, vbNormalFocus
End Sub

und dort befindet sich eine csv-Datei (Komma getrennt).

In dieser Date befinden sich unter anderm Nummern und Texte die auch so in Spalten angezeigt werden.
Eine Spalte ist eine Preisspalte (z.B. 3.35). Diese Zahlen werden grundsätzlich als Datm formatiert.
Ich habe schon alles versucht, aber keine Möglichkeit gefunden diese als Zahl (Preis) zu importieren/öffnen.

Kennt jemand eine Möglichkeit, Makrogesteuert?

Hier mal die Datei zum downloaden und ansehen/ausprobieren:

http://www.x5forum.home-wiekau.de/x5help/csv.zip

Gruß Mario

Hi,

Schau Dir die Datei aus Deinem Zip-Archiv bitte einmal im (Text-) Editor an.
Da steht doch schon "Feb 91" usw. drin. Was soll Excel denn daraus machen?
Gut, ich gehe mal davon aus, dass diese CSV (Semikolon-Getrennt?) nach Deinem
Problem gespeichert wurde. Aber wissen kann ich es nicht. Wenn es so ist,
dann stell doch mal eine "frische" CSV ins Netz.

Wo bekommst Du denn diese CSVs her? Erstellst Du sie selbst?
Evtl. läuft da schon etwas schief.

Und nochmal BITTE: Nutze doch beim Einfügen von Code den enstprechenden
Button über dem Antwort-Fenster. Es erleichtert das Lesen für alle hilfbereiten
User.

[ code]
Dein Code
[ /code]

bye
malSchauen

Hallo,

das

[ code]
Dein Code
[ /code]

werde ich mir zu Herzen nehmen.

Verzeihung zur ZIP-Datei. War wohl zu spät, hatte die Datei schon falsch abgespeichert.

Hier noch mal:
http://www.x5forum.home-wiekau.de/x5help/csv.zip

Die csv wird durch ein DOS-Warenwirtschaftssystem erzeugt, also nichts zu ändern am Format.

Hi,

Mit dem CodeSchnippsel aus #7 öffnest Du ein ExplorerFenster mit vordefiniertem Pfad. Da werden wohl dann Deine CSVs liegen, nehme ich mal an. Was machst Du dann? DoppelKlick auf eine CSV? Oder "ziehst" Du sie mit der Maus ins ExcelFenster? (Beide Versionen führen also zu einem "Neuen Workbook" in der Excel-Instanz (zumindest gehe ich derweil mal davon aus.)) Öffnest Du so immer nur eine einzelne CSV-Datei? oder ziehst Du auch mal mehrere CSVs gleichzeitig ins Excel?

Dein Problem ist, dass die Dateien in der PreisSpalte den Punkt als DezimalTrenner verwenden, und ein deutsches Excel (mit StandardEinstellungen) dort ein Komma erwartet. Lösen liesse sich das, indem Du die Dateien nicht öffnest, sondern als Text IMPORTIERST. (btw. Welche ExcelVersion setzt Du ein?) Nur dürfte das mit Deinem ExplorerFenstern aus dem Code so nicht zusammenpassen. Denkbar wäre der Weg über den .GetOpenFilename-Dialog.

Fragen:

• Immer nur eine CSV zur Zeit?
  
• Sollen die CSVs als jeweils eigene Datei in Excel geöffnet werden? Oder sollen sie auf eine "neue Tabelle" der aufrufenden Datei?
  
• Die Spaltenanzahl in der CSV ist FIX? (also immer gleich?)
  
• Die (fehlerhaften) Preise stehen immer in Spalte "E"?

bye
malSchauen

Hi malSchauen,

die csv-Datei wird ausgewählt mit Doppelklick und öffnet sich im eigenen Fenster.

Zu Deinen Fragen:
Es ist immer nur eine csv.
Wo und in welcher Tabelle ist egal.
Die Spaltenanzahl ist immer gleich.
Die Preise stehen immmer in "E".

Die Startdatei wo das "Private Sub Workbook_Open()" aufgerufen wird, muss offen bleiben, da dort noch mehr Makros aufgerufen werden, die die geöffnete/eingelesene csv weiter verarbeitet.

Mir geht es darum, dass der Preis in Spalte E erhalten bleibt, dann erfolgt eine Weiterverarbeitung mit div. Makros (aut. jpg-Suche, Umbenenungen und einiges mehr). Zum Schluss wird die csv wieder als csv abgespeichert unter anderm Namen und Pfad, aber als csv. Die Datei wird fürs Shopsystem im Internet benötigt, um Artikel automatisch einzulesen und Bilder zuzuordnen.

Hoffe, hab mich gut ausgedrückt.

Herzliche Grüße.

PS. Hab Dir hohhentlich nicht das Wochenende versaut.

Hi,

Wenn Du jetzt die Preise in "E" mit Komma hast, und diese Datei dann als CSV dem ShopSystem vorlegst, kann dieses dann auch damit um? Oder will dieses dann den Preis wieder mit einem Punkt haben? Btw: Deine ExcelVersion hast Du mir noch nicht verraten (XL2000, 2003, ...?).

malSchauen ob folgender Code Dein Problem mit dem Einlesen lösen kann.
Wie bei Deiner bisherigen Version tauchen die Werte der CSV in einer neuen Mappe auf.
Unterschied: Es ist eine neue, ungespeicherte Mappe.

Sub CSV_Import()
    'Variablen
    '=========
    Dim varFileNames As Variant
    Dim strCurDir As String
    Dim varScratch As Variant
    Dim varArrCSV As Variant
    Dim varArrOut As Variant
    Dim lngCount As Long
    Dim lngFF As Long
    Dim wbkTarget As Workbook
    'Konstanten
    '==========
    Const strPath As String = "U:\Grosser\WWG\WWG_WSTA"                                 '<<<<<<anpassen!!!
    
    
    'Dialog aufrufen
    '==========================================
    strCurDir = CurDir                                                                  'aktuellen Pfad auslesen
    ChDrive strPath                                                                     'LW für GOFN-Dialog wechseln
    ChDir strPath                                                                       'Pfad für GOFN-Dialog wechseln
    varFileNames = Application _
        .GetOpenFilename("CSV-Dateien (*.csv), *.csv", 1, "Datei wählen", , False)      'Filenamen holen
    ChDrive strCurDir                                                                   'LW wiederherstellen
    ChDir strCurDir                                                                     'Pfad wiederherstellen
    If VarType(varFileNames) = vbBoolean Then                                           'bei Abbruch
        'MsgBox "Keine Datei gewählt!"                                                   'kleine Meldung
        Exit Sub                                                                        'Makro Ende
    End If
    
    'CSV zu Array
    '==========================================
    lngFF = FreeFile                                                                    'FreeFileNummer holen
    ReDim varArrCSV(1 To 5, 1)                                                          'Array vorbereiten
    Open varFileNames For Input As #lngFF                                               'Datei öffnen
    Do While Not EOF(lngFF)                                                             'bis EOF
        Line Input #lngFF, varScratch                                                   'Zeile einlesen
        varScratch = Split(varScratch, ";")                                             'Zeile an ";" trennen
        ReDim Preserve varArrCSV(1 To 5, 1 To UBound(varArrCSV, 2) + 1)                 'Array vergrössern
        For lngCount = 1 To UBound(varScratch) + 1                                      'Zeilenteile durchlaufen
            'Wenn Zahl dann ersetze "." durch "," und wandle zu Zahl
            'sonst wie gelesen ins Array
            If IsNumeric(varScratch(lngCount - 1)) Then _
                varArrCSV(lngCount, UBound(varArrCSV, 2) - 1) = CDbl(Replace(varScratch(lngCount - 1), ".", ",")) _
            Else _
                varArrCSV(lngCount, UBound(varArrCSV, 2) - 1) = varScratch(lngCount - 1)
        Next lngCount
    Loop
    Close #lngFF                                                                        'Datei Schliessen
    
    'OutArray in neue Mappe
    '==========================================
    Set wbkTarget = Application.Workbooks.Add(1)                                        'Neues Workbook (eine Tabelle)
    varArrOut = WorksheetFunction.Transpose(varArrCSV)                                  'Array drehen
    With wbkTarget.ActiveSheet.Range("A1").Resize(UBound(varArrOut, 1), UBound(varArrOut, 2))
        .Value = varArrOut                                                              'Array am Stück in Tabelle
        .Columns.AutoFit                                                                'SpaltenBreite auf Auto
        .Columns(.Columns.Count).NumberFormat = "0.00"                                  'Format letzte Spalte auf Zahl
    End With
    
    Set wbkTarget = Nothing                                                             'ObjectVerweis aufheben
End Sub

bye
malSchauen
... und um mein Wochenende mach Dir keine Sorgen ;-) Noch ist das SN ja freiwillig...