VBA script - If Condition for file transfer based on table data base

[ravindhars]

Table Structure:
ID, Ms no, Title and Status

Table.jpg

**On Respective “Ms no” there is respective word file in a folder (path)
**Word file name will be like MS 1032 RAW.docx, MS 10594.docx
//Need a VBA script
On if condition or any codeing, need to filter by status field and copy the respective Ms no field files from one folder to another folder path
Eg. If Status = VOLUME 12 ISSUE 2 need to copy all respective files to another path

[OBP]

Do you wish to enter or select a "status" from the status field and then transfer all the files with tthat status?
How do you designate which folder they will be transferred to?

[ravindhars]

Thank you for your reply. Yes i need to select from the [status] field and the relevant [Ms no] field need to be selected and relevant word file bearing the [Ms no] as file name need to be transferred from one folder to another folder.
source folder path = '\\Dell-lptp\d\IJPBS process\Vol - 5, Issue 1\Status List'
destination folder path = '\\Dell-lptp\d\IJPBS process\Vol - 5, Issue 1\Status List\Downloads'

[OBP]

OK, I assume that the table name is V 6 Issue 3.

This will take a little while as I am cooking lunch at the moment, so I will post something later.

[ravindhars]

Thank you for your reply. Ok you can have table name as 'V 6 Issue 3'. Hope you to have a great lunch.

[OBP]

Is the MS No a text field or a Numeric field?

[ravindhars]

Numeric field

[OBP]

OK, I am going to do this in sections. This is the first part where you select the Status from a combo and it opens the table and shows you the File names associated with that status.
If this works OK I will move on to the actual transfer of the files which should be fairly straight forward, but I obviously can't test your identical set up.
Note that the transfer may require you setting the VBA Library Reference for the MS Scripting Runtime in your database.

I would aslo suggest that you copy both folders before running this code in case anything goes wrong.

[ravindhars]

I thanks for this help and i hope this would certainly resolve my problem. Let me execute your codes and will get back to you soon.

[ravindhars]

Thanks a lot. Its working fine

[OBP]

Have you added the File transfer code?
Or do you need help with that part?

[ravindhars]

I have added source path and destination path and now its working fine. Thanks a lot.

[OBP]

Excellent, glad I could help.

[ijpbs]

Sir, In this code if one file is not exist its going to end function. Actually it should go to next MS NO and copy .

File file exist or not exist it should complete all the loop.
For eg., If '10765' file not exist - its ending the loop and code comes out.
I need it should search '10883' and continue till end '10966'

[OBP]

Have you fixed the code?

[ijpbs]

No . Not fixed.

Please find the below code i modified which u sent early as per my requirement.

Function copyall()
Dim response, rs As Object, count As Integer, filecount As Integer, SQL As String, FSO As Object, filename As String
    'Dim FSO As Object
    
    Dim filenameraw As String
    Dim FromPathraw As String
    Dim ToPathraw As String
    
    Dim filenamecta As String
    Dim ToPathcta As String
    Dim FromPathcta As String
    
    Dim filenameinvoice As String
    Dim FromPathinvoice As String
    Dim ToPathinvoice As String
    
    
Set FSO = CreateObject("Scripting.FileSystemObject")
On Error GoTo errorcatch
    response = MsgBox("Are You Sure You Want to Transfer " & Me.Combo0 & " Files", vbYesNo + vbExclamation + vbDefaultButton2)
    If response = vbNo Then Exit Function ' User chose No.
SQL = "SELECT [V 6 issue 3].* " & _
"FROM [V 6 issue 3] " & _
"WHERE Status = '" & Me.Combo0 & "' "
Set rs = CurrentDb.OpenRecordset(SQL)
If rs.RecordCount <> 0 Then
    rs.MoveLast
    rs.MoveFirst
End If
filecount = rs.RecordCount
For count = 1 To filecount
If Not IsNull(rs![Ms no]) Then
    'filename = "MS " & rs.[Ms no] & ".docx"
    filenameraw = "MS " & rs.[Ms no] & "*"  '<< Change
    filenamecta = "MS " & rs.[Ms no] & "*"  '<< Change
    filenameinvoice = "Invoice * " & rs.[Ms no] & "*"  '<< Change
    MsgBox filenameraw
    FromPathraw = "\\Dell-lptp\d\IJPBS process\Vol - 5, Issue 1\Rawarticles\"  '<< Change RAW
    ToPathraw = "\\DELL-LPTP\BackupVolume\RAW\"    '<< Change RAW
    
    FromPathcta = "\\Dell-lptp\d\IJPBS process\Vol - 5, Issue 1\CTA form recieved from authors new version\"  '<< Change CTA
    ToPathcta = "\\DELL-LPTP\BackupVolume\CTA\"    '<< Change CTA
    
   FromPathinvoice = "\\Dell-lptp\d\IJPBS process\Vol - 5, Issue 1\Invoice sent to author\"  '<< Change Invoice
    ToPathinvoice = "\\DELL-LPTP\BackupVolume\Invoice\"    '<< Change Invoice


    'FileExt = "*" & a & " RAW*.*"  '<< Change
    
   If Right(FromPathraw, 1) <> "\" Then
     FromPathraw = FromPathraw & "\"
    End If
    
    If Right(FromPathcta, 1) <> "\" Then
     FromPathcta = FromPathcta & "\"
    End If
    
    If Right(FromPathinvoice, 1) <> "\" Then
     FromPathinvoice = FromPathinvoice & "\"
    End If
    Set FSO = CreateObject("scripting.filesystemobject")


   FSO.CopyFile Source:=FromPathraw & filenameraw, Destination:=ToPathraw
   FSO.CopyFile Source:=FromPathcta & filenamecta, Destination:=ToPathcta
   FSO.CopyFile Source:=FromPathinvoice & filenameinvoice, Destination:=ToPathinvoice
   
   MsgBox "Succesfully done"
End If
rs.MoveNext
Next count
Exit Function
errorcatch:
MsgBox Err.Description
End Function

For eg., If '10765' file not exist - its ending the loop and code comes out.
I need it should search '10883' and continue till end '10966'

[OBP]

In the error trap after Msgbox Err.Description add a new line
msgbox Err.Number or change change
Msgbox Err.Description to
Msgbox Err.Description & " Error Number - " & Err.Number
This will establish the error that occurs, when you have the "error number" you can add a line
If Err.Number = "error number" then resume next

[ijpbs]

This is the code i have changed.
'''
errorcatch:
MsgBox Err.Description
MsgBox Err.Number
MsgBox Err.Description & " Error Number - " & Err.Number
If Err.Number = "Error Number" Then Resume Next
'''
Error showing Type mismatch - Run time error 13.

[OBP]

I am sorry, that is my fault, I did not explain it clearly enough.
This line
If Err.Number = "Error Number" Then Resume Next
The part that says "Error Number" needs to be replaced with the Numeric Value of the actual error number that you get when the error occurs from the line above.
So you need to remove that line causing the error until you have a number to put in it.

[ijpbs]

Superb, now its working fine. Excellent