Dim FSO As New FileSystemObject
Dim CN As New ADODB.Connection, RS As New ADODB.Recordset

Private Sub CmdExecute_Click()
Dim DataArray(40, 6) As String
Dim Product_Type As String, Plastic_Type As String, Issue_Date As Date
Dim Issue_Type As String, CARD_TYPE As String
Dim fl As File, FLD As Folder, SourceFLD As Folder, BaseFLD As Folder
Dim I As Integer, J As Integer
Dim RunDate As Date, StartDate As Date, EndDate As Date
Dim TGT_EMB_FN As String, TGT_CCR_FN As String
StartDate = DtpStartDate.Value - 1: EndDate = DtpEndDate.Value - 1
CN.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & CN_Path
If TxtEmbFolder <> "" Then
    If FSO.FolderExists(TxtEmbFolder) Then
        Set FLD = FSO.GetFolder(TxtEmbFolder)
        For RunDate = StartDate To EndDate
            If Not FSO.FolderExists(TxtTgtFolder + "\" + CStr(Format(RunDate, "YYYY"))) Then
                FSO.CreateFolder TxtTgtFolder + "\" + CStr(Format(RunDate, "YYYY"))
            End If
            If Not FSO.FolderExists(TxtTgtFolder + "\" + CStr(Format(RunDate, "YYYY")) + "\" + CStr(Format(RunDate, "YYYY MM"))) Then
                FSO.CreateFolder TxtTgtFolder + "\" + CStr(Format(RunDate, "YYYY")) + "\" + CStr(Format(RunDate, "YYYY MM"))
            End If
            If Not FSO.FolderExists(TxtTgtFolder + "\" + CStr(Format(RunDate, "YYYY")) + "\" + CStr(Format(RunDate, "YYYY MM")) + "\AEME_CARD_PERSO_" + CStr(Format(RunDate, "DDMMYY"))) Then
                FSO.CreateFolder TxtTgtFolder + "\" + CStr(Format(RunDate, "YYYY")) + "\" + CStr(Format(RunDate, "YYYY MM")) + "\AEME_CARD_PERSO_" + CStr(Format(RunDate, "DDMMYY"))
            End If
            Set BaseFLD = FSO.GetFolder(TxtTgtFolder + "\" + CStr(Format(RunDate, "YYYY")) + "\" + CStr(Format(RunDate, "YYYY MM")) + "\AEME_CARD_PERSO_" + CStr(Format(RunDate, "DDMMYY")))
            'If (OptAllCards.Value = True) Or (OptExcludeRens.Value = True) Then
                Dim FileRS As ADODB.Recordset, ProdRS As ADODB.Recordset
                Set ProdRS = New ADODB.Recordset
                ProdRS.Open "SELECT DISTINCT CARD_PRODUCT_CODE FROM PWC_AFS_19072018 WHERE ISSUE_TYPE IN ('NEW','REPLACEMENT','RENEWAL') AND FILE_TYPE='REG' AND PRODUCT_TYPE<>'TITANIUM'", CN
                If Not ProdRS.EOF Then
                    Do While Not ProdRS.EOF
                        Set FileRS = New ADODB.Recordset
                        FileRS.Open "SELECT CARD_PRODUCT_CODE, PWC_FILE_NAME_E, AFS_FILE_NAME_E, PWC_FILE_NAME_C, AFS_FILE_NAME_C, FILE_TYPE, ISSUE_TYPE, PORTFOLIO FROM PWC_AFS_19072018 WHERE ISSUE_TYPE IN ('NEW','REPLACEMENT','RENEWAL') AND FILE_TYPE='REG' AND CARD_PRODUCT_CODE='" & CStr(ProdRS!CARD_PRODUCT_CODE) & "' AND PRODUCT_TYPE<>'TITANIUM'", CN
                        If Not FileRS.EOF Then
                            Select Case FileRS!Portfolio
                            Case "REVOLVE"
                                Do While Not FileRS.EOF
                                    If FSO.FileExists(FLD.Path & "\Embossing File\" & CStr(FileRS!PWC_FILE_NAME_E) & CStr(Format(RunDate, "DDMMYY"))) Then
                                        Set fl = FSO.GetFile(FLD.Path & "\Embossing File\" & CStr(FileRS!PWC_FILE_NAME_E) & CStr(Format(RunDate, "DDMMYY")))
                                        TGT_EMB_FN = FileRS!AFS_FILE_NAME_E & CStr(Format(RunDate, "DDMMYY")) & ".txt"
                                        
                                        Get_Proc fl, BaseFLD.Path, TGT_EMB_FN
                                        Set fl = Nothing
                                        If FSO.FileExists(FLD.Path & "\Card Carrier\" & CStr(FileRS!PWC_FILE_NAME_C) & CStr(Format(RunDate, "DDMMYY")) & ".txt") Then
                                            Set fl = FSO.GetFile(FLD.Path & "\Card Carrier\" & CStr(FileRS!PWC_FILE_NAME_C) & CStr(Format(RunDate, "DDMMYY")) & ".txt")
                                            TGT_CCR_FN = FileRS!AFS_FILE_NAME_C & CStr(Format(RunDate, "DDMMYY")) & ".txt"
                                            Get_Proc fl, BaseFLD.Path, TGT_CCR_FN
                                            Set fl = Nothing
                                        ElseIf Not FSO.FileExists(FLD.Path & "\Card Carrier\" & CStr(FileRS!PWC_FILE_NAME_C) & CStr(Format(RunDate, "DDMMYY")) & ".txt") Then
                                            MsgBox "Card carrier file " & CStr(FileRS!PWC_FILE_NAME_C) & " not found for embossing file " & CStr(FileRS!PWC_FILE_NAME_E) & "." & Chr(13) & Chr(13) & "Please check if all files were generated and transferred to the shared drive.", vbOKOnly + vbCritical, "Outsource Embossing"
                                        End If
                                    End If
                                    If Not FileRS.EOF Then FileRS.MoveNext
                                Loop
                            Case Else
                                Do While Not FileRS.EOF
                                    If FSO.FileExists(FLD.Path & "\Embossing_ChargeCards\" & CStr(FileRS!PWC_FILE_NAME_E) & CStr(Format(RunDate, "DDMMYY"))) Then
                                        Set fl = FSO.GetFile(FLD.Path & "\Embossing_ChargeCards\" & CStr(FileRS!PWC_FILE_NAME_E) & CStr(Format(RunDate, "DDMMYY")))
                                        TGT_EMB_FN = FileRS!AFS_FILE_NAME_E & CStr(Format(RunDate, "DDMMYY")) & ".txt"
                                        Get_Proc fl, BaseFLD.Path, TGT_EMB_FN
                                        Set fl = Nothing
                                        If (FSO.FileExists(FLD.Path & "\Embossing_ChargeCards\" & CStr(FileRS!PWC_FILE_NAME_C) & CStr(Format(RunDate, "DDMMYY")))) Or (FSO.FileExists(FLD.Path & "\Embossing_ChargeCards\" & CStr(FileRS!PWC_FILE_NAME_C) & CStr(Format(RunDate, "DDMM")))) Then
                                            If (FSO.FileExists(FLD.Path & "\Embossing_ChargeCards\" & CStr(FileRS!PWC_FILE_NAME_C) & CStr(Format(RunDate, "DDMMYY")))) Then
                                                Set fl = FSO.GetFile(FLD.Path & "\Embossing_ChargeCards\" & CStr(FileRS!PWC_FILE_NAME_C) & CStr(Format(RunDate, "DDMMYY")))
                                            ElseIf (FSO.FileExists(FLD.Path & "\Embossing_ChargeCards\" & CStr(FileRS!PWC_FILE_NAME_C) & CStr(Format(RunDate, "DDMM")))) Then
                                                Set fl = FSO.GetFile(FLD.Path & "\Embossing_ChargeCards\" & CStr(FileRS!PWC_FILE_NAME_C) & CStr(Format(RunDate, "DDMM")))
                                            End If
                                            TGT_CCR_FN = FileRS!AFS_FILE_NAME_C & CStr(Format(RunDate, "DDMMYY")) & ".txt"
                                            Get_Proc fl, BaseFLD.Path, TGT_CCR_FN
                                            Set fl = Nothing
                                        End If
                                    End If
                                    If Not FileRS.EOF Then FileRS.MoveNext
                                Loop
                            End Select
                        ElseIf FileRS.EOF Then
                            MsgBox "File name definitions could not be found." & Chr(13) & Chr(13) & "Please contact the system administrator.", vbOKOnly + vbCritical, "Outsource Embossing"
                        End If
                        FileRS.Close: Set FileRS = Nothing
                        If Not ProdRS.EOF Then ProdRS.MoveNext
                    Loop
                End If
                ProdRS.Close: Set ProdRS = Nothing
            'End If
            'If (OptAllCards.Value = True) Or (OptRensOnly.Value = True) Then
                Dim PWC_REN_EMB_NAME As String, PWC_RES_EMB_NAME As String, PWC_RES_CCR_NAME As String
                Dim AFS_REN_EMB_NAME As String, AFS_REN_CCR_NAME As String, AFS_RES_EMB_NAME As String, AFS_RES_CCR_NAME As String
                Dim SFL As TextStream, TFL As TextStream, TSTR As String, FILE_STAT_STR As String, FLNO As Integer
                Set ProdRS = New ADODB.Recordset
                ProdRS.Open "SELECT DISTINCT CARD_PRODUCT_CODE FROM PWC_AFS_19072018 WHERE ISSUE_TYPE IN ('REISSUE') AND FILE_TYPE='REG' AND PRODUCT_TYPE<>'TITANIUM'", CN
                If Not ProdRS.EOF Then
                    Do While Not ProdRS.EOF
                        Set FileRS = New ADODB.Recordset
                        FileRS.Open "SELECT CARD_PRODUCT_CODE, PWC_FILE_NAME_E, AFS_FILE_NAME_E, PWC_FILE_NAME_C, AFS_FILE_NAME_C, FILE_TYPE, ISSUE_TYPE, PORTFOLIO FROM PWC_AFS_19072018 WHERE ISSUE_TYPE IN ('REISSUE') AND FILE_TYPE='REG' AND CARD_PRODUCT_CODE='" & CStr(ProdRS!CARD_PRODUCT_CODE) & "' AND PRODUCT_TYPE<>'TITANIUM'", CN
                        If Not FileRS.EOF Then
                            Select Case FileRS!Portfolio
                            Case "REVOLVE"
                                Do While Not FileRS.EOF
                                    If FSO.FileExists(FLD.Path & "\Embossing File\" & CStr(FileRS!PWC_FILE_NAME_E) & CStr(Format(RunDate, "DDMMYY"))) Then
                                        Set fl = FSO.GetFile(FLD.Path & "\Embossing File\" & CStr(FileRS!PWC_FILE_NAME_E) & CStr(Format(RunDate, "DDMMYY")))
                                        TGT_EMB_FN = FileRS!AFS_FILE_NAME_E & CStr(Format(RunDate, "DDMMYY")) & ".txt"
                                        Get_Proc fl, BaseFLD.Path, TGT_EMB_FN
                                        Set fl = Nothing
                                        If FSO.FileExists(FLD.Path & "\Card Carrier\" & CStr(FileRS!PWC_FILE_NAME_C) & CStr(Format(RunDate, "DDMMYY")) & ".txt") Then
                                            Set fl = FSO.GetFile(FLD.Path & "\Card Carrier\" & CStr(FileRS!PWC_FILE_NAME_C) & CStr(Format(RunDate, "DDMMYY")) & ".txt")
                                            TGT_CCR_FN = FileRS!AFS_FILE_NAME_C & CStr(Format(RunDate, "DDMMYY")) & ".txt"
                                            Get_Proc fl, BaseFLD.Path, TGT_CCR_FN
                                            Set fl = Nothing
                                        ElseIf Not FSO.FileExists(FLD.Path & "\Card Carrier\" & CStr(FileRS!PWC_FILE_NAME_C) & CStr(Format(RunDate, "DDMMYY")) & ".txt") Then
                                            MsgBox "Card carrier file " & CStr(FileRS!PWC_FILE_NAME_C) & " not found for embossing file " & CStr(FileRS!PWC_FILE_NAME_E) & "." & Chr(13) & Chr(13) & "Please check if all files were generated and transferred to the shared drive.", vbOKOnly + vbCritical, "Outsource Embossing"
                                        End If
                                    End If
                                    If Not FileRS.EOF Then FileRS.MoveNext
                                Loop
                            Case Else
                                Do While Not FileRS.EOF
                                    If FSO.FileExists(FLD.Path & "\Embossing_ChargeCards\" & CStr(FileRS!PWC_FILE_NAME_E) & CStr(Format(RunDate, "DDMMYY"))) Then
                                        Set fl = FSO.GetFile(FLD.Path & "\Embossing_ChargeCards\" & CStr(FileRS!PWC_FILE_NAME_E) & CStr(Format(RunDate, "DDMMYY")))
                                        TGT_EMB_FN = FileRS!AFS_FILE_NAME_E & CStr(Format(RunDate, "DDMMYY")) & ".txt"
                                        Get_Proc fl, BaseFLD.Path, TGT_EMB_FN
                                        Set fl = Nothing
                                        If (FSO.FileExists(FLD.Path & "\Embossing_ChargeCards\" & CStr(FileRS!PWC_FILE_NAME_C) & CStr(Format(RunDate, "DDMMYY")))) Or (FSO.FileExists(FLD.Path & "\Embossing_ChargeCards\" & CStr(FileRS!PWC_FILE_NAME_C) & CStr(Format(RunDate, "DDMM")))) Then
                                            If (FSO.FileExists(FLD.Path & "\Embossing_ChargeCards\" & CStr(FileRS!PWC_FILE_NAME_C) & CStr(Format(RunDate, "DDMMYY")))) Then
                                                Set fl = FSO.GetFile(FLD.Path & "\Embossing_ChargeCards\" & CStr(FileRS!PWC_FILE_NAME_C) & CStr(Format(RunDate, "DDMMYY")))
                                            ElseIf (FSO.FileExists(FLD.Path & "\Embossing_ChargeCards\" & CStr(FileRS!PWC_FILE_NAME_C) & CStr(Format(RunDate, "DDMM")))) Then
                                                Set fl = FSO.GetFile(FLD.Path & "\Embossing_ChargeCards\" & CStr(FileRS!PWC_FILE_NAME_C) & CStr(Format(RunDate, "DDMM")))
                                            End If
                                            TGT_CCR_FN = FileRS!AFS_FILE_NAME_C & CStr(Format(RunDate, "DDMMYY")) & ".txt"
                                            Get_Proc fl, BaseFLD.Path, TGT_CCR_FN
                                            Set fl = Nothing
                                        End If
                                    End If
                                    If Not FileRS.EOF Then FileRS.MoveNext
                                Loop
                            End Select
                        ElseIf FileRS.EOF Then
                            MsgBox "File name definitions could not be found." & Chr(13) & Chr(13) & "Please contact the system administrator.", vbOKOnly + vbCritical, "Outsource Embossing"
                        End If
                        FileRS.Close: Set FileRS = Nothing
                        If Not ProdRS.EOF Then ProdRS.MoveNext
                    Loop
                End If
                ProdRS.Close: Set ProdRS = Nothing
            'End If
        Next
        Set FLD = Nothing
        MsgBox "All Charge, Corporate and Revolve Embossing and Card Carrier files copied into the folder.", vbOKOnly + vbInformation, "Outsource Embossing"
    ElseIf Not FSO.FolderExists(TxtEmbFolder) Then
        MsgBox "Folder entered is invalid." & Chr(13) & Chr(13) & "PLease enter a valid folder name.", vbOKOnly + vbCritical, "Outsource Embossing"
    End If
ElseIf TxtEmbFolder = "" Then
    MsgBox "Folder name field is empty." & Chr(13) & Chr(13) & "PLease enter a valid folder name.", vbOKOnly + vbCritical, "Outsource Embossing"
End If
CN.Close
Set CN = Nothing
End Sub

Sub Perso_File_Copy(TempFL As File, FolderName As String, FileName As String)
On Error Resume Next
Dim TempFSO As New FileSystemObject, TgtFL As File
FileCopyStatus = "Pending"
Do While (Not TempFSO.FileExists(FolderName & "\" & FileName)) Or (FileCopyStatus = "Pending")
    TempFL.Copy FolderName & "\" & FileName, True
    Set TgtFL = TempFSO.GetFile(FolderName & "\" & FileName)
    If TgtFL.Size = 0 Then
        FileCopyStatus = "Pending"
        Start = Timer
        C = C + 1
        Do While Timer < Start + 2
            'DoEvents
        Loop
    ElseIf TgtFL.Size > 0 Then
        FileCopyStatus = "Completed"
    End If
Loop
End Sub

Private Sub Command1_Click()
Dim fl As File
Set fl = FSO.GetFile("C:\Users\NVenkata\Documents\Testfile.txt")
Get_Proc fl, "C:\Users\NVenkata\Documents\Acq Recon", "Testerrrr.txt"
End Sub

Sub Get_Proc(Variable_Pass As File, FolderName As String, FileName As String)
'On Error Resume Next
Variable_Pass.Copy FolderName & "\" & FileName, True
'Dim TempFSO As New FileSystemObject, TgtFL As File
'FileCopyStatus = "Pending"
'Do While (Not TempFSO.FileExists(FolderName & "\" & FileName)) Or (FileCopyStatus = "Pending")
'
'    Set TgtFL = TempFSO.GetFile(FolderName & "\" & FileName)
'    If TgtFL.Size = 0 Then
'        FileCopyStatus = "Pending"
'        Start = Timer
'        C = C + 1
'        Do While Timer < Start + 2
'            'DoEvents
'        Loop
'    ElseIf TgtFL.Size > 0 Then
'        FileCopyStatus = "Completed"
'    End If
'Loop
End Sub