Copy and overwrite text files from one folder to another (1 Viewer)

lookforsmt

Registered User.
Local time
Today, 19:09
Joined
Dec 26, 2011
Messages
560
Hi! all i am looking to copy latest text files from one folder to another using VBA. The text file name consists of 4 parts:

ICCSC01001026171215111900

Part1) ICCSC01
Part2) 001026
Part3) 171215
Part4) 111900
The 1st part is the file type code and 3rd part is the date in format "YYMMDD"

Based on 1st and 3rd part i want to copy the files from the "OriginalFolder" to the "NewFolder"

I am looking in the forum for the vba code but nothing close

Can anyone help me with the code.
 

arnelgp

error reading drive A:
Local time
Today, 23:09
Joined
May 7, 2009
Messages
8,813
here is a code.
copy and paste to new Standard Module.

to call (example):

Call CopyICS("D:\OriginalFolder", "D:\NewFolder")
Code:
Public Sub CopyICS(ByVal SourceFolder As String, _
                        ByVal TargetFolder As String, _
                        Optional ByVal Extension As String = "txt")

    Const FileName As String = "ICCSC"
    Dim strTempFile As String
    Dim thisFile As String
    Dim FileColl As Collection
    Dim intLen As Integer
    Dim i As Integer
    
    Set FileColl = New Collection
    
    intLen = Len(FileName) + 2
    SourceFolder = Replace(SourceFolder & "\", "\\", "\")
    TargetFolder = Replace(TargetFolder & "\", "\\", "\")
    
    strTempFile = Dir(SourceFolder & "*." & Extension)
    
    Do While strTempFile <> ""
        If Left(strTempFile, intLen) <> thisFile Then
            thisFile = Left(strTempFile, intLen)
            strTempFile = Replace(strTempFile, "." & Extension, "")
            FileColl.Add Left(strTempFile, 13) & "*" & Right(strTempFile, 6)
        End If
        strTempFile = Dir()
    Loop
    If FileColl.Count <> 0 Then
        For i = 1 To FileColl.Count
            Call CopyICS2(SourceFolder, TargetFolder, FileColl.Item(i), Extension)
        Next
        MsgBox "Files have been copied to " & TargetFolder
    End If
    Set FileColl = Nothing
End Sub

Private Sub CopyICS2(ByVal SourceFolder As String, _
                        ByVal TargetFolder As String, _
                        ByVal FileName As String, _
                        ByVal Extension As String)


    Dim strTempFile As String
    Dim thisFile As String
    
    SourceFolder = Replace(SourceFolder & "\", "\\", "\")
    TargetFolder = Replace(TargetFolder & "\", "\\", "\")
    
    strTempFile = Dir(SourceFolder & FileName & "*." & Extension)
    thisFile = strTempFile
    Do While strTempFile <> ""
        If strTempFile > thisFile Then _
            thisFile = strTempFile
        strTempFile = Dir()
    Loop
    On Error Resume Next
    Kill TargetFolder & thisFile
    On Error GoTo 0
    VBA.FileCopy SourceFolder & thisFile, TargetFolder & thisFile
End Sub
 

lookforsmt

Registered User.
Local time
Today, 19:09
Joined
Dec 26, 2011
Messages
560
Sorry & apologies, couldn't test the code earlier. Thanks arnelgp for the code. I want to thank you from the bottom of my heart.

Just wanted one clarification, i am calling the code but it copies only one file for todays date out of 8 files from the whole lot of files present in the "OrginalFolder".

There are total 8 files on daily basis that are saved and the rest of the files are for earlier dates.

Can this code copy only the file based on part3 "yymmdd" as mentioned in my post #1 which is todays date only.
Also, if the code could tell me the name of files copied to the "NewFolder"

Thanks
 

arnelgp

error reading drive A:
Local time
Today, 23:09
Joined
May 7, 2009
Messages
8,813
Code:
'1. ICCSC01 *
'2. 001026  *
'3. 171215
'4. 111900  *
Public Sub CopyICS(ByVal SourceFolder As String, _
                        ByVal TargetFolder As String, _
                        Optional ByVal Extension As String = "txt")

    Const FileName As String = "ICCSC"
    Dim strTempFile As String
    Dim strTempFile2 As String
    Dim thisFile As String
    Dim FileColl As Collection
    Dim intLen As Integer
    Dim i As Integer
    
    Set FileColl = New Collection
    
    'intLen = Len(FileName) + 2
    intLen = Len(FileName) + 8
    SourceFolder = Replace(SourceFolder & "\", "\\", "\")
    TargetFolder = Replace(TargetFolder & "\", "\\", "\")
    
    strTempFile = Dir(SourceFolder & "*." & Extension)
    
    Do While strTempFile <> ""
        ' remove the extension from strTempFile
        strTempFile = Replace(strTempFile, "." & Extension, "")
        ' compare to strTempFile to thisFile
        If Left(strTempFile, intLen) & Right(strTempFile, 6) <> thisFile Then
            ' not same, save this to the collection
            thisFile = Left(strTempFile, intLen) & Right(strTempFile, 6)
            FileColl.Add Left(strTempFile, 13) & "*" & Right(strTempFile, 6)
        End If
        ' find next matching filename
        strTempFile = Dir()
    Loop
    ' if collection is not empty
    If FileColl.Count <> 0 Then
        ' find and save the latest date for the file
        For i = 1 To FileColl.Count
            Call CopyICS2(SourceFolder, TargetFolder, FileColl.Item(i), Extension)
        Next
        MsgBox "Files have been copied to " & TargetFolder
    Else
        MsgBox "No files were copied."
    End If
    Set FileColl = Nothing
End Sub

Private Sub CopyICS2(ByVal SourceFolder As String, _
                        ByVal TargetFolder As String, _
                        ByVal FileName As String, _
                        ByVal Extension As String)


    Dim strTempFile As String
    Dim thisFile As String
    
    strTempFile = Dir(SourceFolder & FileName & "*." & Extension)
    thisFile = strTempFile
    Do While strTempFile <> ""
        If strTempFile > thisFile Then _
            thisFile = strTempFile
        strTempFile = Dir()
    Loop
    On Error Resume Next
    Kill TargetFolder & thisFile
    On Error GoTo 0
    VBA.FileCopy SourceFolder & thisFile, TargetFolder & thisFile
End Sub
 

lookforsmt

Registered User.
Local time
Today, 19:09
Joined
Dec 26, 2011
Messages
560
Dear arnelgp

Thank you so much for your help. i really dont have words to express how much it means to me. You have really helped me so many times and i am thankful to you.

i have tested the code and works as required. It moves the latest 8 text file from OriginalFolder to NewFolder.

ICCSC01001026171218111900
ICCSC01001034171218111900
ICCSC01001037171218111900
ICCSC01001051171218111900
ICCSC51001026171218111101
ICCSC51001034171218111501
ICCSC51001037171218111501
ICCSC51001051171218111501
Thanks
I will close the thread as solved
 

Users Who Are Viewing This Thread (Users: 0, Guests: 1)

Top Bottom