Consulting

Results 1 to 20 of 20

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

  1. #1

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

    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

  2. #2
    VBAX Guru
    Joined
    Mar 2005
    Posts
    3,296
    Location
    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?

  3. #3
    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'

  4. #4
    VBAX Guru
    Joined
    Mar 2005
    Posts
    3,296
    Location
    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.

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

  6. #6
    VBAX Guru
    Joined
    Mar 2005
    Posts
    3,296
    Location
    Is the MS No a text field or a Numeric field?

  7. #7
    Numeric field

  8. #8
    VBAX Guru
    Joined
    Mar 2005
    Posts
    3,296
    Location
    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.
    Attached Files Attached Files
    Last edited by OBP; 06-25-2021 at 06:53 AM.

  9. #9
    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.

  10. #10
    Thanks a lot. Its working fine

  11. #11
    VBAX Guru
    Joined
    Mar 2005
    Posts
    3,296
    Location
    Have you added the File transfer code?
    Or do you need help with that part?

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

  13. #13
    VBAX Guru
    Joined
    Mar 2005
    Posts
    3,296
    Location
    Excellent, glad I could help.

  14. #14
    VBAX Regular
    Joined
    Jul 2021
    Posts
    23
    Location
    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'

  15. #15
    VBAX Guru
    Joined
    Mar 2005
    Posts
    3,296
    Location
    Have you fixed the code?

  16. #16
    VBAX Regular
    Joined
    Jul 2021
    Posts
    23
    Location
    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'

  17. #17
    VBAX Guru
    Joined
    Mar 2005
    Posts
    3,296
    Location
    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

  18. #18
    VBAX Regular
    Joined
    Jul 2021
    Posts
    23
    Location
    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.

  19. #19
    VBAX Guru
    Joined
    Mar 2005
    Posts
    3,296
    Location
    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.

  20. #20
    VBAX Regular
    Joined
    Jul 2021
    Posts
    23
    Location
    Superb, now its working fine. Excellent

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •