OK, checked and working.
I will post the code in full.
Dim CheckFile, FileFound As String, i As Integer, datastring As String, xchar As String Dim sDest As String, firstfile As String, filcopied As Integer, reccount As Integer Dim ctlList As Control, varItem As Integer, posn As Integer, FileName As String, result As Integer, fileinarray As Integer CheckFile = Array("TESTMAIN", "TESTCASE", "TESTPRIMARY", "TESTSECONDARY", "TESTALTERNATE") On Error GoTo errorcatch 'The following lines of code use a network path for the source file : sDest = "C:\Users\A C\Downloads\TestFolder\" ' & CheckFile(0) ' will be changed to CurrentProject.path & MAXIMOExports Set ctlList = Me.List0 For varItem = 0 To ctlList.ListCount - 1 For x = 1 To Len(ctlList.ItemData(varItem)) ' Parse filename only If Mid(ctlList.ItemData(varItem), x, 1) = "\" Then posn = x Next x firstfile = ctlList.ItemData(varItem) FileName = Right(ctlList.ItemData(varItem), Len(ctlList.ItemData(varItem)) - posn) 'MsgBox varItem & " - " & FileName result = 0 fileinarray = 0 filecopied = 0 For i = LBound(CheckFile) To UBound(CheckFile) result = InStr(1, ctlList.ItemData(varItem), CheckFile(i)) 'MsgBox ctlList.ItemData(varItem) & " - " & CheckFile(i) If result <> 0 Then MsgBox result & " - File is in array append it" fileinarray = 1 FileFound = Dir(sDest & "*" & CheckFile(i) & "*.*") If FileFound = "" Then fileinarray = 0 Exit For End If GoSub Appendsub 'Open sSourceFile For Input As SourceFileNum Do Until FileFound = "" ' Start the loop. ctr = ctr + 1 FileFound = Dir() ' Getting next entry. If FileFound <> "" Then GoSub Appendsub Loop Exit For End If Next i If fileinarray = 0 Then If filecopied = 0 Then MsgBox result & " - file is not in array copy it" FileCopy ctlList.ItemData(varItem), sDest & FileName filecopied = 1 End If End If Next varItem Exit Sub errorcatch: Close #2 Close #1 MsgBox "Error - " & Err.Description Appendsub: MsgBox "current file appending to - " & FileFound & " from - " & FileName reccount = 0 datastring = "" Open firstfile For Input As #1 Open sDest & FileFound For Append As #2 Do Until EOF(1) xchar = Input(1, #1) If xchar = vbLf Then reccount = reccount + 1 If reccount > 0 Then datastring = datastring & xchar End If Loop 'MsgBox datastring Print #2, datastring Close #1 Close #2 MsgBox "data transferred to " & FileFound Return




Reply With Quote