Bestandsnamen vervangen in MAP

[Juup]

Hallo

Volgens mij is dit een ingewikkelde vraag
Proef Bestand bijgevoegd

Ik zou graag willen dat een foto bestand wordt gevonden, hernoemd , en daarna onder de nieuwe naam wordt opgeslagen op de computer
Nu heb ik alles tot aan Kolom K
maar de foto moet nu daadwerkelijk hernoemd worden en in de map geplaatst worden
Het is een uitgebreid bestand qua kolommen maar is tevens bedoeld als mijn controle of er een foto is en hoe hij uiteindelijk gaat heten en waar te vinden

Dit laatste het Vinden, hernoemen en kopiëren in de map lukt mij niet

Wie weet de oplossing ?????

Uitleg
Kolom A en C = Zijn creteria
Kolom E = wordt via macro opgezocht vanuit kolom M en geeft het celadres
Kolom G = nieuwe bestandsnaam voor de foto (artikelcode)
Kolom I= celadres wat gegenereerd wordt vanuit kolom E
Kolom K = Nieuwe naam voor de foto met adres.

 

[HSV]

Als het bestand wordt gevonden wordt het niet gekopieerd, wel wordt het hernoemd en in de juiste map geplaatst van de waarde van kolom K (mits deze map bestaat).

Sub hsv()
Dim cl As Range, naam As String, oldname As String, Newname As String
For Each cl In Sheets("Blad1").Range("I1:I" & Sheets("Blad1").Cells(Rows.Count, 9).End(xlUp).Row)
   If Dir(cl) = "" Then
       MsgBox "Bestand:" & vbLf & vbLf & cl.Value & vbLf & vbLf & "is niet gevonden."
     Else
      oldname = cl
      Newname = cl.Offset(, 2).Value
      Name oldname As Newname
    End If
 Next cl
End Sub

 

[Juup]

Hallo Harry

Bedankt voor de Macro hij is bijna goed:d
Alleen blijft hij ergens hangen

Als ik hem uitprobeer, dan gaat het goed tot het een LEGE cel bereikt ("") dan stopt de macro omdat hij het pad niet kan vinden (bestandsnaam enz.)
Zou jij het zo kunnen maken dat hij wel doorgaat tot einde
Ik heb niet veel verstand van Macro's maar ik denk dat er een SUB string in moet


Ik heb niet van alle artikelen een foto maar zo komen de meest wel in de goede map
Kan ik later foto's toevoegen en de macro weer opnieuw draaien

Ik hoop dat het je lukt

alvast bedankt

Juup

 

[HSV]

Hallo Juup,


Probeer het zo maar eens.

Sub hsv()
Dim cl As Range, naam As String, oldname As String, Newname As String
For Each cl In Sheets("Blad1").Range("I1:I" & Sheets("Blad1").Cells(Rows.Count, 9).End(xlUp).Row)[COLOR=#FF0000].specialcells(2)[/COLOR]
   If Dir(cl) = "" Then
       MsgBox "Bestand:" & vbLf & vbLf & cl.Value & vbLf & vbLf & "is niet gevonden."
     Else
      oldname = cl
      Newname = cl.Offset(, 2).Value
      Name oldname As Newname
    End If
 Next cl
End Sub

 

[Juup]

HOOO:evil:

Bedankt voor de snelle reactie maar nu gaat het niet goed
hij copieert niets

geeft foutcode 1004 tijdens uitvoering
Er zijn geen cellen gevonden

Kun je er nog eens naar kijken

 

[HSV]

Het zijn formules zie ik nu pas.
In principe zou het met 'Specialcells(-4123)' moeten werken, maar doe het maar op een betrouwbaarder manier.

Sub hsv()
Dim cl As Range, naam As String, oldname As String, Newname As String
For Each cl In Sheets("Blad1").Range("I6:I" & Sheets("Blad1").Cells(Rows.Count, 9).End(xlUp).Row)
If cl <> vbNullString Then
   If Dir(cl) = "" Then
       MsgBox "Bestand:" & vbLf & vbLf & cl.Value & vbLf & vbLf & "is niet gevonden."
     Else
      oldname = cl
      Newname = cl.Offset(, 2).Value
      Name oldname As Newname
    End If
  End If
 Next cl
End Sub

 

[Juup]

Hallo HSV

Werkt bijna goed, zo snel als ik het uitproberen kan, Moet nu FF Eten:evil:,
Geeft alleen foutcode aan als de foto bestaat dat hij het niet overschrijven kan
Kun je dit ook nog oplossen ???

 

[HSV]

Eet smakelijk,

Je bedoelt dat als de foto wel bestaat in kolom I maar dat er in kolom K geen geldig pad is waar het naar toe geschreven kan worden, of de cel in leeg is?

 

[Juup]

Nee ik bedoel dat de foto gekopieerd wordt naar de map in kolom K
als hier de foto al bestaat kan hij hem dan overschrijven

Ik heb alsnog even het tot nu toe aangepaste proefbestand aangekoppeld
met de macro's er in

Bekijk bijlage Proef 4.xlsm

 

[HSV]

Doe wat fotokopieën in een twee testmapjes voordat ze verloren gaan.

Sub hsv()
Dim cl As Range, naam As String, oldname As String, Newname As String
For Each cl In Sheets("Blad1").Range("I6:I" & Sheets("Blad1").Cells(Rows.Count, 9).End(xlUp).Row)
If cl <> vbNullString Then
   If Dir(cl) = "" Then
       MsgBox "Bestand:" & vbLf & vbLf & cl.Value & vbLf & vbLf & "is niet gevonden."
     Else
      oldname = cl
      Newname = cl.Offset(, 2).Value
    On Error Resume Next
      Kill Newname
    On Error GoTo 0
      Name oldname As Newname
    End If
  End If
 Next cl
End Sub

 

[Juup]

Hallo Harry

Ben er weer om te zeuren.

Ben aan het uitproberen geweest

Als ik de macro voor de eerste keer draai, dan verplaatst hij de foto's uit de map naar de nieuwe map
hij vindt volgens de melding scherm 3x maar 3 foto's die er niet zijn
Ik heb alles nagekeken maar de 3 foto's zijn er wel. (ook de namen enz gecontroleerd op spelling klopt ook allemaal)
Ook volgens mijn excel geeft hij in kolom I dat het bestaat

Als ik het daarna nakijk in mijn bestandsmap dan zijn de foto's ook verwijderd (On Error Go To ??)

Als ik de macro voor de 2e keer draai krijg ik de ene melding na de andere (Melding foto niet gevonden) dit omdat de foto's zijn verplaatst i.p.v gekopieerd naar de nieuwe map
Ik heb het liefst gekopieerd maar dan moet bij de melding overschrijven JA gegeven worden

Kun je hier iets mee
Heb ook een nieuw proef5 bestand gekoppeld

Ik hoor het graag Bekijk bijlage Proef 5.xlsm

 

[HSV]

Lijkt me wel logisch.
Er staan nl. een aantal keren hetzelfde adres in kolom E (bv. 2x $M$13, 2x $M$16)
Als het eerste bestand weg is krijg je bij de tweede de msgbox dat het bestand niet aanwezig is.

Hier onder een methode die een kopie maakt van het bestand, en het in de ander map zet met een ander naam.

Sub hsv()
Dim cl As Range, naam As String, oldname As String, Newname As String
For Each cl In Sheets("Blad1").Range("I6:I" & Sheets("Blad1").Cells(Rows.Count, 9).End(xlUp).Row)
If cl <> vbNullString Then
   If Dir(cl) = "" Then
       MsgBox "Bestand:" & vbLf & vbLf & cl.Value & vbLf & vbLf & "is niet gevonden."
     Else
       FileCopy cl, cl.Offset(, 2)
    End If
  End If
 Next cl
End Sub

 

[Juup]

Hallo Harry

Hartstikke bedankt
Alles werkt

Het klopt dat er dubbele bestanden worden gebruikt (dit mag niet gebeuren )
Zou je voor mij nog een macro of formule kunnen schrijven hoe ik dit kan controleren
Zodra het nummer dubbel is dit qua tekst of gekleurde cel duidelijk kunnen maken ???
Dit moet ik ook voor de artikel nummers kunnen gebruiken

Zou erg fijn zijn als je dit lukt

gr Juup

 

[HSV]

Dat kan met voorwaardelijke opmaak als het door formules geregeld is.
Je geeft daar een kleurtje aan, en de formule is:
=aantal.als(E$6:E$1000;E6)>0
Is het een handmatige invoer, dan kan het ook met validatie in de cel met dezelfde formule.
Als het dan een dubbele invoer is verschijnt er een melding dat de invoer al bestaat.

 

[Juup]

Hoi Harry

Ik ga het uitproberen als ik er even de tijd voor heb
Alvast hartelijk bedankt
Kan weer verder

Mocht ik weer vragen hebben zal ik een nieuwe vraag stellen in het forum

Hartstikke bedankt

gr Juup

 

[HSV]

Hallo Juup,

Vergeet dan niet de vraag als opgelost te zetten als het is gelukt.
Bvd.