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

[ravindhars]

Table Structure:
ID, Ms no, Title and Status

28637

**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