Teller werkt niet VBA

[Geep]

Hoi allemaal,

Deze vba code doet bestanden kopiereren, de teller die mee loopt
werkt niet goed, zou iemand mij daarmee kunnen helpen.

Loes

 

[Warme bakkertje]

Probeer het zo eens.

 

[Geep]

Warm Bakkertje,

Helaas de teller loopt nog niet mee.

Loes

 

[Ginger]

Geep, en hoe weet je dat dan? Dat de teller niet meeloopt? Ik zie nergens een msgbox oid die de waarde van NumFiles weergeeft.
En heb je je code al 'ns stap voor stap doorlopen met F8? Komt de code wel in dat lusje om de teller te verhogen? Zo niet, dan moet je nagaan wat de waarde is van het Err.Number (of Err in jouw geval).

 

[Geep]

klik op de button als je de code opstart.

vervolgens worden de pdf bestanden in
C:\Users\Acer\Documents\SmartTrue Desktop
geknipt en naar de map E:\2016 en E:2016\new verplaatst


Daana krijg je een popup te zien hoeveel pdf bestanden er zijn gekopieerd.
En dat is niet goed hij blijft 0 bestanden (PDF) aangeven, terwijl er 3 bestanden (PDF) zijn gekopieerd

Loes

 

[Warme bakkertje]

Public NumFiles As Integer
Private Sub CommandButton1_Click()
    Dim SourceDir As String
    Dim TargetDir As String
    SourceDir = "C:\Users\Acer\Documents\SmarThru Desktop"
    TargetDir = "E:\A2B4U\Opdrachten\2016"
    CopyFile SourceDir, TargetDir
    MsgBox "Number of files copied = " & NumFiles

End Sub
Sub CopyFile(SrcDir As String, TrgtDir As String)
    Dim OldDir As String  'source dir name
    Dim NewDir As String 'target dir name
    Dim FileName As String 'source filename

    OldDir = SrcDir
    If Right$(OldDir, 1) <> "\" Then
        OldDir = OldDir & "\"
    End If

    NewDir = TrgtDir
    If Right$(NewDir, 1) <> "\" Then
        NewDir = NewDir & "\"
    End If

    NumFiles = 0      'returns # files copied
    
    FileName = Dir$(OldDir & "*.pdf")
    
    While FileName <> ""
        FileCopy (OldDir & FileName), (NewDir & FileName)
        If Err = 0 Then NumFiles = NumFiles + 1
        On Error GoTo 0
        FileName = Dir$        'get next matching file
        DoEvents            'allow processes to occur
    Wend
End Sub

 

[Geep]

Warm bakkertje,

Allereerst hartelijk dank voor de vba code,
alleen de map C:\Users\Acer\Mijn Documenten\SmarThru Desktop
moet na het kopieren leeg zijn en de bestanden moeten in
2 mappen staan E:\A2B4U\Opdrachten\2016\New en E:\A2B4U\Opdrachten\2016

Dank je wel.

PS. de teller werkt !!

Loes

 

[Warme bakkertje]

Private Sub CommandButton1_Click()
    Dim SourceDir As String, TargetDir As String, TargetDir2 As String
    Dim Numfiles As Integer, i As Integer

    SourceDir = "C:\Users\Acer\Documents\SmarThru Desktop\"
    TargetDir = "E:\A2B4U\Opdrachten\2016\"
    TargetDir2 = "E:\A2B4U\Opdrachten\2016\New\"
    
    Numfiles = 0      'returns # files copied
    
    FileName = Dir$(SourceDir & "*.pdf")
    
    While FileName <> ""
        For i = 1 To 2
            FileCopy SourceDir & FileName, Choose(i, TargetDir & FileName, TargetDir2 & FileName)
        Next
        Kill SourceDir & FileName
        If Err = 0 Then Numfiles = Numfiles + 1
        On Error GoTo 0
        FileName = Dir$        'get next matching file
        DoEvents            'allow processes to occur
    Wend
    
    MsgBox "Number of files copied = " & Numfiles

End Sub

 

[snb]

Private Sub CommandButton1_Click()
    shell "cmd /c copy ""C:\Users\Acer\Documents\SmarThru Desktop\*.pdf"" E:\A2B4U\Opdrachten\2016\"
    kill """C:\Users\Acer\Documents\SmarThru Desktop\*.pdf"""
End Sub

NB. Vermijd spaties in foldernamen.

 

[Geep]

Beste Warme bakkertje,

Heel erg bedankt voor de vba code,
het werkt perfect.

snb
kill werkt niet, ik heb del geprobeerd maar die is niet gedefinieerd !!


Loes

 

[snb]

Kill werkt wel.

Controleer het pad eerst eens.

 

[Geep]

Het is het zelfde pad als 'Warme bakkertje" gebruikt
heeft in de vba code, en dat werkt wel.


Maar het is wel een mooie korte code van jou. Heel slim !!!


Loes