• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Op basis van excel lijst bestanden verplaatsen naar nieuwe locatie

Status
Niet open voor verdere reacties.
D

danvie

Gebruiker
Lid geworden
30 jul 2007
Berichten
34
Goedemorgen,

Ik ben bezig met een conversie van data naar organice (een sharepoint gebasseerd systeem voor bestandsbeheer). Nu zijn we aan het importeren van data op basis van door mij aangeleverde excel formats en krijg ik een error report terug van mislukte imports. de bestanden die wel zijn gelukt (zie voorwaarde verplaats in sheet) wil ik echter nog dezelfde dag verplaatsen van een bepaalde (zie excelsheet) locatie naar een nieuwe (nog aan te maken) locatie.
Bestanden vinden zich op zeer veel verschillende locaties maar de doelbestemming is altijd de oude bestemming met de directory temp ervoor.

Kan iemand mij hiermee helpen?

Bekijk bijlage Verplaatsen bestanden na import organice.xls
 
Laatst bewerkt:
Zet de volgende twee macro's in je excel sheet:

Code: 
Sub Verplaats_Data()

Call Eerst_Sorteren

LSearchRow = 2
While Len(Range("A" & CStr(LSearchRow)).Value) > 0

Dim Welk_Bestand As Range
Dim Van_Welke_Locatie As Range
Dim Naar_Welke_Locatie As Range

Set Welk_Bestand = ActiveSheet.Range("$B$" & LSearchRow)
Set Van_Welke_Locatie = ActiveSheet.Range("$C$" & LSearchRow)
Set Naar_Welke_Locatie = ActiveSheet.Range("$D$" & LSearchRow)


'Het wordt nu in een message box weer gegeven als je echt uit wil voeren kan je deze weg halen
MsgBox "Verplaatsen " & Van_Welke_Locatie & Welk_Bestand & "Naar " & Naar_Welke_Locatie & Welk_Bestand

' Als je echt wil gaan verplaatsen moet je voor onderstaande regel de ' weg halen
'Name Van_Welke_Locatie & Welk_Bestand As Naar_Welke_Locatie & Welk_Bestand

LSearchRow = LSearchRow + 1
Wend


End Sub

Code: 
Sub Eerst_Sorteren()
'
' Eerst_Sorteren Macro
'

'
    Columns("A:D").Select
    ActiveWorkbook.ActiveSheet.Sort.SortFields.Clear
    ActiveWorkbook.ActiveSheet.Sort.SortFields.Add Key:=Range("A2:A13") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.ActiveSheet.Sort
        .SetRange Range("A:D")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("A1").Select
End Sub
 
Thanks.
Ik ga er maandag weer mee aan de slag en laat dan weten hoe het verder werkt.
 
Ik heb even een kleine test gedraaid maar volgens mij moeten de paden die in de excelsheet staan ook al bestaan. Nu is het zo dat dat nog niet altijd het geval is. Is de macro aan te passen zodat een eventuele niet bestaande map dan ook weer wordt aangemaakt?
 
Ik kom voor het testen en aanmaken van de directory structuur dan niet verder als :

Code: 
If Dir(ActiveSheet.Range("$D$" & LSearchRow).Value, vbDirectory) = "" Then
      MkDir (ActiveSheet.Range("$D$" & LSearchRow).Value)
End If

Volgens mij gaat de test of de directory bestaat wel goed maar daarna loopt de macro vast. Het zal ongetwijfeld iets simpels zijn maar helaas gaat mijn kennis daar net niet ver genoeg voor.

De code ziet er dan als onderstaand uit:

Code: 
Sub Verplaats_Data()

Call Eerst_Sorteren

LSearchRow = 2
While Len(Range("A" & CStr(LSearchRow)).Value) > 0

Dim Welk_Bestand As Range
Dim Van_Welke_Locatie As Range
Dim Naar_Welke_Locatie As Range

Set Welk_Bestand = ActiveSheet.Range("$B$" & LSearchRow)
Set Van_Welke_Locatie = ActiveSheet.Range("$C$" & LSearchRow)
Set Naar_Welke_Locatie = ActiveSheet.Range("$D$" & LSearchRow)


'Het wordt nu in een message box weer gegeven als je echt uit wil voeren kan je deze weg halen
MsgBox "Verplaatsen " & Van_Welke_Locatie & Welk_Bestand & "Naar " & Naar_Welke_Locatie & Welk_Bestand

If Dir(ActiveSheet.Range("$D$" & LSearchRow).Value, vbDirectory) = "" Then
      MkDir (ActiveSheet.Range("$D$" & LSearchRow).Value)
End If

' Als je echt wil gaan verplaatsen moet je voor onderstaande regel de ' weg halen
Name Van_Welke_Locatie & Welk_Bestand As Naar_Welke_Locatie & Welk_Bestand

LSearchRow = LSearchRow + 1
Wend


End Sub
 
Laatst bewerkt:
Het is me gelukt.
op de site van pearson (http://www.cpearson.com/Excel/MakeDirMulti.aspx) een stukje gevonden over het aanmaken van meerdere directories in een keer.

Dank je geep1980 voor het op weg helpen.

Jouw eerste stukje code is nu aangevuld met wat code van pearson en zorgt er nu voor dat ik die duizenden files in een keer kan omzetten waar ze naartoe moeten.

Mocht er nog iemand geinteresseerd zijn dan wil ik het bestandje nog wel even toevoegen.

mvg,
Daniel
 
Uiteraard mag je je oplossing hier posten. Het doel van dit forum is toch dat iedereen , iedereen helpt nietwaar. Zodoende kan jouw oplossing misschien anderen helpen bij het oplossen van hun problemen. :thumb:
 
Da is een bestandje dat mij geweldig kan helpen.

Ik heb er een probleempje in. Ik zou aan de hand van die lijst bepaalde foto's naar een map verplaatsen.
Het probleem is dat er voor sommige artikels geen foto is, en dan stopt de excel. Is er een manier dat die dat overslaat wanneer de foto niet bestaat en dan de volgende verplaatsen.

Stefaan
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan