Documenten verplaatsen

[Magik]

Hoi,

Ik probeer een macro voor elkaar te krijgen maar ik mis iets.
Ik heb een map op mijn bureaublad met daarin tal van afbeeldingen en deze staan ook in een excel lijst.
In de lijst heb ik wat wetenswaardigheden over de afbeeldingen staan.
Tijdens het bewerken van de afbeeldingen filter ik in de excel lijst de afbeeldingen die ik verwerkt heb en zou dan willen dat als ik in de lijst de naam van de afbeelding selecteer de afbeeldingen vanuit de basis map naar een verwerkt map verplaatst.
Pfff wat een zin, hoop dat het nog te volgen is.

Wat ik heb is als volgt:

Sub MovetoFolder()

Dim FSO As Object
Dim SourcePath As String
Dim DestPath As String
Dim FileExt As String

SourcePath = "C:\Users\Administrator\Desktop\VBA-move-doc" '
DestPath = "C:\Users\Administrator\Desktop\VBA-move-doc\Verwerkt"
FileExt = "* *.jpg *"

Set FSO = CreateObject("scripting.filesystemobject")

If FSO.FolderExists(Left(SourcePath, Len(SourcePath) - 1)) = False Then
MsgBox SourcePath & " Niet gevonden"
Exit Sub
End If

FSO.MoveFile Source:=SourcePath & FileExt, Destination:=DestPath

End Sub


Hij kan echter de *.jpg's niet vinden
Ik zie het even niet.
Iemand die het wel ziet?

Gr Dick

 

[edmoor]

Je verteld er niet bij wat er nu niet werkt.
Maar net zoals vele anderen vergeet je dat er tussen een foldernaam en een bestand een \ hoort:

SourcePath & "\" & FileExt

Daarnaast kan je ook gewoon de MOVE functie van VBA gebruiken voor het verplaatsen van bestanden en de DIR functie om te controleren of een folder bestaat.

 

[HSV]

Zou hier niet een backslash achter moeten?

SourcePath = "C:\Users\Administrator\Desktop\VBA-move-doc[COLOR=#ff0000][SIZE=4]\[/SIZE][/COLOR]"

 

[Magik]

Bedankt Edmoor en HSV,

Tijdens het testen had ik het vermoeden dat hij meer deed zonder de \ dan met.
Om die rede stond hij er niet bij maar jullie hebben gelijk hij moet er gewoon achter.
Misschien was ik net mijn eigen tekst aan het editen en is er overheen gelezen maar de macro kan het bestand niet vinden.
Ik heb een klein bestandje gemaakt, misschien leest dat beter

 

[HSV]

In grote lijnen werkt het zo.

Sub MovetoFolder()
 
    Dim FSO As Object
    Dim SourcePath As String
    Dim DestPath As String
    Dim FileExt As String
    Dim oFile As Object


     SourcePath = "C:\Users\Administrator\Desktop\VBA-move-doc\" '
     DestPath = "C:\Users\Administrator\Desktop\VBA-move-doc\Verwerkt\"

Set FSO = CreateObject("scripting.filesystemobject")
      For Each oFile In FSO.getfolder(SourcePath).Files
        If Right(oFile, 4) = ".jpg" Then
          FileExt = oFile
        
    FSO.MoveFile Source:=FileExt, Destination:=DestPath
    End If
  Next oFile
End Sub

 

[Magik]

Goede Morgen,

Deze werkt inderdaad, alleen zou niet werken op het moment dat je er een paar honderd in je lijst hebt staan en je die niet in 1 keer gaat verwerken.
In dat geval zou je willen dat hij enkel de geselecteerde cellen in de lijst verplaatst.
Ik moet dus denk ik iets doen met een Range of een Selection.
Nu heb ik dat geval dus ook en zal niet in 1x de hele lijst afwerken, maar wil wel tussentijds die documenten alvast uit de map hebben.
Ik krijg het echter niet voor elkaar iets te maken zodat hij enkel kijkt naar de geselecteerde cellen.

Gr Dick

 

[edmoor]

Laat in een voorbeeld documentje zien wat je bedoelt met "geselecteerde cellen".

 

[Magik]

Stel ik selecteer cellen A3:A7 en A12:A13 Zie afb.
De macro zou dan enkel deze documenten moeten verplaasten.
De geselecteerde cellen zullen ALTIJD in de eerste kolom staan.
De regel kan echter wel steeds anders zijn bv A1, A3 en A9.

Gr Dick

Overigens is die van Harry wel heel brut, hij verplaatst alle jpg's in de map.
ook de gene die niet in de lijst staan.

 

[edmoor]

Ik zou er zoiets van maken:

Sub MovetoFolder()
    Dim BronPad As String
    Dim DoelPad As String
    Dim Plaatje As String
    Dim cl As Range
    
    BronPad = "C:\Users\Administrator\Desktop\VBA-move-doc\"
    DoelPad = BronPad & "Verwerkt\"

    For Each cl In Selection
        Plaatje = cl.Value & ".jpg"
        If Dir(BronPad & Plaatje) <> "" Then
            On Error Resume Next
            Kill DoelPad & Plaatje
            On Error GoTo 0
            Name BronPad & Plaatje As DoelPad & Plaatje
        End If
    Next cl
End Sub

 

[Magik]

Door:
DoelPad = "C:\Users\Administrator\Desktop\VBA-move-doc\Verwerkt"
te maken werkte het helemaal.

Ik zie ook dat je bij Dim cl de mijn selectie mogelijk maakt en daar was ik naar op zoek

Bedankt

 

[edmoor]

Door:
DoelPad = "C:\Users\Administrator\Desktop\VBA-move-doc\Verwerkt"

Dat hoeft helemaal niet, wat er staat is goed:

DoelPad = BronPad & "Verwerkt\"

 

[Magik]

Hoi,

Ik heb toch even gekeken of je gelijk had.
Ik was idd te voorbarig, waarschijnlijk niet het geduld gehad om goed te testen.
Ik heb het nu in het document aangepast en het werkt op zich goed.
Wel viel mij op dat ik geen melding kreeg als het document helemaal niet in de map zit?

Ik denk dat ik eens ga zoeken naar een printfunctie die de niet aanwezige documenten kan uitprinten.

Bedankt en mocht ik iets vinden of willen weten kom ik hier nog op terug.

Gr Dick

 

[edmoor]

De test zit al in de code, hoef je alleen maar een messagebox bij te maken.

        If Dir(BronPad & Plaatje) <> "" Then
            On Error Resume Next
            Kill DoelPad & Plaatje
            On Error GoTo 0
            Name BronPad & Plaatje As DoelPad & Plaatje
[COLOR="#FF0000"]        Else
            MsgBox BronPad & Plaatje, vbInformation, "Afbeelding niet aanwezig"[/COLOR]
        End If

Ik denk dat ik eens ga zoeken naar een printfunctie die de niet aanwezige documenten kan uitprinten.

Dat lijkt me onmogelijk!

Maar kijk eens naar deze:
Bekijk bijlage Move-doc-1.xlsm

 

[snb]

waarom wijzig je de naam van een verwekt bestand niet ?

Bijv. na verwerking van PSTANK018a.jpg in P_STANK018a.jpg
Verplaatsen kan dan op het laatst met 2 VBAregels.