Bestand verplaatsen met extra data uit een cel

[ExcelTonnie]

Ik wil bestanden archiveren naar een map en de Datum uit cel A1 moet ervoor komen.
Dus bijv. 38-2020 Piet.xlsm

[B][/B]Sub verplaats()
Name "S:\Omnirapport\Piet.xlsm" As "S:\Omnirapport\Achive\Piet.xlsm"
End Sub

 

[edmoor]

Zo:

Sub verplaats()
    Name "S:\Omnirapport\Piet.xlsm" As "S:\Omnirapport\Achive\" & Range("A1").Value & " Piet.xlsm"
End Sub

Hierbij ga ik er wel vanuit dat cel A1 geen tekens bevat die niet in een bestandsnaam mogen worden gebruikt.

 

[HSV]

Piet en bestandsextensie kan zonder het koppelteken Ed.

 

[edmoor]

Heb je uiteraard helemaal gelijk aan

 

[ExcelTonnie]

Dit werkt goed maar nu wil ik dit uitbreiden wat ook werkt maar hoe kan ik afvangen als een van deze niet bestaat in deze map.

 Sub verplaats()
    Name "S:\Omnirapport\Piet.xlsm" As "S:\Omnirapport\Achive\" & Range("A1").Value & " Piet.xlsm"
Name "S:\Omnirapport\Jan.xlsm" As "S:\Omnirapport\Achive\" & Range("A1").Value & " Jan.xlsm"
Name "S:\Omnirapport\Willem.xlsm" As "S:\Omnirapport\Achive\" & Range("A1").Value & " Willem.xlsm"
End Sub

 

[edmoor]

Waarom gebruik je de inspringpunten niet?
Doe het eens zo:

 Sub verplaats()
    Dim Namen() As String
    
    Namen = Split("Piet,Jan,Willem", ",")
    For i = 0 To UBound(Namen)
        If Dir("S:\Omnirapport\" & Namen(i) & ".xlsm") <> "" Then
            Name "S:\Omnirapport\" & Namen(i) & ".xlsm" As "S:\Omnirapport\Achive\" & Range("A1").Value & " " & Namen(i) & ".xlsm"
        End If
    Next i
End Sub

 

[ExcelTonnie]

Op zich werkt dit prima maar ben er achter dat in mijn geval er teveel files overgezet moet worden en dit toch niet zo fijn werkt.
Wat volgens mij veel handiger zou zijn is dat alle files met de extentie [XLSM] uit bijv map S:\QADeventer\Productie Testmap verplaatst worden naar
S:\QADeventer\Server Testmap met toevoeging uit Cel A1
Ben daar nog mee aan stoeien maar hulp zou zeer welkom zijn.

Sub Transfer()
    Dim Namen() As String
    'Controle of de map bestaat waar de gemeten files in moeten komen
    If Dir("S:\QADeventer\Productie Testmap\", vbDirectory) = "" Then
        MsgBox "De map " & "S:\QADeventer\Productie Testmap\ is niet aanwezig.", vbCritical, "Map niet aanwezig"
        Exit Sub
    End If
    'Controle of de map bestaat waar de gemeten files in moeten komen op de server
    If Dir("S:\QADeventer\Server Testmap\", vbDirectory) = "" Then
        MsgBox "De map " & "S:\QADeventer\Server Testmap\ is niet aanwezig.", vbCritical, "Map niet aanwezig"
        Exit Sub
    End If
'
    Namen = Split("Mnd-Jr  Bramen controle NDG 3 basis,Jan,Willem", ",")
    For i = 0 To UBound(Namen)
        Name "S:\QADeventer\Productie Testmap\" & Namen(i) & ".xlsm" _
          As "S:\QADeventer\Server Testmap\" & Range("A1").Value & " " & Namen(i) & ".xlsm"
    Next i
End Sub

 

[VenA]

Waarom iemand vermoeien met berichtjes? Je kan de mappen dan toch net zo goed aanmaken.

Sub VenA()
  c00 = "E:\Temp\"
  c01 = "E:\Temp\test\"
  If Dir(c00, 16) = "" Then MkDir c00
  If Dir(c01, 16) = "" Then MkDir c01

  ar = Split(CreateObject("WScript.Shell").Exec("cmd /c dir /b " & c00 & "*.xlsm*").StdOut.readall, vbCrLf)
  For j = 0 To UBound(ar) - 1
    Name c00 & ar(j) As c01 & Range("a1").Value & ar(j)
  Next j
End Sub

 

[ExcelTonnie]

Inderdaad is het niet nodig om mensen de vraagjes te stellen en is deze manier natuurlijk beter.
Echter werkt het verder niet zoals omschreven. Krijg geen foutmeldingen.

De bedoeling is om alle bestanden die in een bepaalde map staan om deze te verplaatsen naar een map op een server met toevoeging in de naam uit cel A1. Zie dit ook terug in de code echter zegt mij de rest niet zoveel.
Maar voor zoals gezegd doet de code verder niets.

Sub VenA()
  c00 = "S:\QADeventer\Productie Testmap\"
  c01 = "S:\QADeventer\Server Testmap\"
  If Dir(c00, 16) = "" Then MkDir c00
  If Dir(c01, 16) = "" Then MkDir c01

  ar = Split(CreateObject("WScript.Shell").Exec("cmd /c dir /b " & c00 & "*.xlsm*").StdOut.readall, vbCrLf)
  For j = 0 To UBound(ar) - 1
    Name c00 & ar(j) As c01 & Range("a1").Value & ar(j)
  Next j
End Sub

 

[VenA]

Welke waarden krijg je te zien in de variabele ar?

Het * acthter xlsm* kan nog weg.

 

[ExcelTonnie]

Het * was me al opgevallen maar dan nog gebeurt er niets. Heel even een zwart schermpje.

 

[VenA]

Nogmaals; Welke waarden krijg je te zien in de variabele ar?

 

[ExcelTonnie]

Geen enkele waarde(n)

 

[VenA]

Dan staan er geen .xlsm bestanden in de map S:\QADeventer\Productie Testmap\

 

[ExcelTonnie]

Nogmaals; Welke waarden krijg je te zien in de variabele ar?

Er staan wel degelijk xlsm bestanden in de S\QADeventer\Productie Testmap

De waarden bedoel je daar de waarden mee die in de S:\QADeventer\Server Testmap moeten komen?

 

[VenA]

Het blijft altijd bijzonder waarom het bij de ene wel werkt en bij de vraagsteller nooit.

Voor


Tijdens


Na

 

[ExcelTonnie]

Ja dat begrijp ik ook niet waarom, vaak omdat jullie tovenaars zijn denk ik.

 

[VenA]

Ik mis het plaatje tijdens.

 

[ExcelTonnie]

Deze afbeeldingen heb ik uit de verkenner (mijn computer)

Het tijdens afbeelding, weet niet hoe jij dit kan zien.
Hoe kan ik dit zien.
Op het moment dat ik de makro start dan komt er heel even een popup-scherm in zwart en verdwijnt weer.

 

[VenA]

Vanuit de VBeditor de code uitvoeren. Met het scherm locals aan kan je stap voor stap zien wat er gebeurt en welke waarde(n) de variabele(n) krijgen. Ook wel debuggen genoemd.