1. Computer problem? Tech Support Guy is completely free -- paid for by advertisers and donations. Click here to join today! If you're new to Tech Support Guy, we highly recommend that you visit our Guide for New Members.

VB code to select and move file from dir to dir

Discussion in 'Business Applications' started by Knightster, Jan 22, 2015.

Thread Status:
Not open for further replies.
Advertisement
  1. Knightster

    Knightster Thread Starter

    Joined:
    Jan 22, 2015
    Messages:
    11
    Hi, I am using Vb6 in windows7

    I have an .xlsx file name "D123456_98765xyc.xlsx" in a location eg C:\my docs\folder 1

    I would like some vb code to move "D123456_98765xyc" to location C:\my docs\folder 2

    The problem is that I want the script to locate and move the file by using only the first part of the file name e.g "D123456"

    The idea is that I input "D12345" into a textbox in a userform that I have created and the code will search out the file with "D12345" as part of the file name and moves that file to another folder.

    I'm a newbie at this so any help is appreciated, Thanks in advance guys !!
     
  2. draceplace

    draceplace

    Joined:
    Jun 8, 2001
    Messages:
    2,583
    Welcome to TSG!
    The code below will Prompt for some text, search the contents of a folder for file with the text in the name a move/copy to a different folder.
    Copy and save this into notepad and save as SomeName.vbs file.

    Code:
    '---------------------------------------------------------------
    '-- Dan McCracken 01/23/2014-------------------------------------
    '---Searches objStartFolder for input string in file name 
    'Moves to strMoveToFolder
    '---Move/copy file with input box
    ' Skips if file exists
    'don't move copy to the same folder
    ' objStartFolder
    ' strMoveToFolder
    ' ---------------------------------------------------------------
    
    'set up for write file
    Const ForAppending = 8
    Const ForWriting = 2
    cntFileID = 0
    cntFileMove = 0
    DocSkipCnt = 0
    cntFileID = 0
    
    'xxxxxxxxxxxxxxxxxxxxxxxxxxxxx'
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    'start search
    objStartFolder = "H:\A1"   'Folder name here<----
    
    'copying files to drop box folder
    strMoveToFolder = "H:\A2\"              'Folder name here<-----
    'xxxxxxxxxxxxxxxxxxxxxxxxxxxxx'
    MsgTitle = "Knightster-Move File Utility"
    Msg2 = "Knightster Moving/Copy Cancelled by User "
    Msg1 = "Knightster Moving/Copy from Here: " & objStartFolder & vbCrLf _
           & "To Here: " & strMoveToFolder & vbCrLf
    strStopGo = MsgBox(Msg1, vbOKCancel, MsgTitle)
    
    If strStopGo = vbOK Then
    'Input string to search
    strInput = InputBox("Enter File Name",MsgTitle)
    
     Set objFolder = objFSO.GetFolder(objStartFolder)
     Set colFiles = objFolder.Files
      For Each objFile In colFiles
    
                    cntFileID = cntFileID + 1
                    strFullPath = objFSO.GetAbsolutePathName(objFile)
                    strFileNameA = objFile.Name
       		strNewFile = strMoveToFolder & strFileNameA
    		
    		'Wscript.Echo strFileNameA & vbCrLf & strInput & vbCrLf & myPos
      If InStr(LCase(strFileNameA), LCase(strInput)) > 0 Then
          If objFSO.FileExists(strNewFile) Then
             DocSkipCnt = DocSkipCnt + 1
          Else
            objFSO.CopyFile (strFullPath), strNewFile
            'objFSO.MoveFile (strFullPath), strNewFile
    		cntFileMove = cntFileMove + 1
          End If 'for FileExist
      End If 'for inStr
      
      Next
       
    Wscript.Echo "Knightster Wow! It Finished - " & Now() & vbCrLf & "Records Searched: " _
                               & Right(String(6, "0") & CStr(cntFileID), 6) _
    			   & vbCrLf & "Records Moved: " _
    			   & Right(String(6, "0") & CStr(cntFileMove), 6) _
                               & vbCrLf & "Docs Exist Skipped: : " & DocSkipCnt
    Else
     MsgBox Msg2, vbOKOnly, MsgTitle
    End If 'stop this now -
    
    WScript.Quit
     
  3. draceplace

    draceplace

    Joined:
    Jun 8, 2001
    Messages:
    2,583
    Note that I've commented the MoveFile and used CopyFile for my test. You will need to reverse the comment tick to move your file. Also used LCase to make the search non case sensitive.
     
  4. Knightster

    Knightster Thread Starter

    Joined:
    Jan 22, 2015
    Messages:
    11
    Great Thank You draceplace (Dan),

    Where do I paste this code and how do I launch it,

    Sorry but I am a newbie,
     
  5. draceplace

    draceplace

    Joined:
    Jun 8, 2001
    Messages:
    2,583
    This is vb script. The code should work in a VB6 project but I don't know how to do that. To run and execute this
    Copy and save this into notepad then save\rename as SomeName.vbs file.

    I use Notepad ++(its free) to edit but it can be edited in notepad.
    Double click to execute
     
  6. Knightster

    Knightster Thread Starter

    Joined:
    Jan 22, 2015
    Messages:
    11
    Oops just answered my own question "Double click .vbs file" :)
    works a treat !! thanks Dan.

    How can I incorporate this into a userform ?
     
  7. Knightster

    Knightster Thread Starter

    Joined:
    Jan 22, 2015
    Messages:
    11
    I don't want to copy I only want to move files, which parts do I need to remove so that it doesn't make copies.

    I really appreaciate your help :)
     
  8. draceplace

    draceplace

    Joined:
    Jun 8, 2001
    Messages:
    2,583
    Change the commented (tick mark) line. like below
    Else
    'objFSO.CopyFile (strFullPath), strNewFile
    objFSO.MoveFile (strFullPath), strNewFile

    Sorry, I don't use VB6 proper but I do know parts of the code will do what your wanting incorporated into the VB6 application. You will need to change the Start and MoveTo folders to match your system. I can answer questions about the code but no help with VB forms
     
  9. Knightster

    Knightster Thread Starter

    Joined:
    Jan 22, 2015
    Messages:
    11
    Thanks Dan You've been a great help !!
     
  10. draceplace

    draceplace

    Joined:
    Jun 8, 2001
    Messages:
    2,583
    You are welcome, glad to help. Feel free to post back with additional question concerning the code.
     
  11. Knightster

    Knightster Thread Starter

    Joined:
    Jan 22, 2015
    Messages:
    11
    It's working great.
    I have managed to assign the code to a button on my userform " works fine".
    Is there a way in which I could tell it to search only the first 7 sylables of the file names,
    for instance file P142345_54321ABC (search red section of file name) and and must be an exact match. (for example if I searched for "P142345" then P142345"_54321ABC would be moved over and not P142346_54322DEF, P142347_54323GHI would not be moved over)
    Return Msg "Search not valid" If more or less than 7 characters used in search input.
    p,s I still have not managed to get it to move the files only (i.e not make a copy).

    Thank You, you been awesome so far !!
     
  12. draceplace

    draceplace

    Joined:
    Jun 8, 2001
    Messages:
    2,583
    Good work getting it to work off you button!!
    You have to comment or delete the CopyFile line and Uncomment the MoveFile lines. (done in code below)

    If you replace from 'xxxx down...

    The partial code below incorporates searching the first 7 characters and enforces an input of 7(note the addition of strFileNameA7 and the If below input, Else at the bottom. If you get much fancier than this you may need a validation subroutine or something. I'm about to be busy doing my real job but will reply when I can.
    Code:
    'xxxxxxxxxxxxxxxxxxxxxxxxxxxxx'
    MsgTitle = "Knightster-Move File Utility"
    MsgTitleBad = "Invalid Search Criteria"
    Msg3 = "File name to search must be 7 characters"
    Msg2 = "Knightster Moving/Copy Cancelled by User "
    Msg1 = "Knightster Moving/Copy from Here: " & objStartFolder & vbCrLf _
           & "To Here: " & strMoveToFolder & vbCrLf
    strStopGo = MsgBox(Msg1, vbOKCancel, MsgTitle)
    
    If strStopGo = vbOK Then
    'Input string to search
    strInput = InputBox("Enter 7 characters of File Name",MsgTitle)
     If Len(strInput) = 7 Then 
     Set objFolder = objFSO.GetFolder(objStartFolder)
     Set colFiles = objFolder.Files
      For Each objFile In colFiles
    
                    cntFileID = cntFileID + 1
                    strFullPath = objFSO.GetAbsolutePathName(objFile)
                    strFileNameA = objFile.Name
       		strNewFile = strMoveToFolder & strFileNameA
    		strFileNameA7 = Left(StrFileNameA,7)
    		
      If InStr(LCase(strFileNameA7), LCase(strInput)) > 0 Then
      'If InStr(LCase(strFileNameA), LCase(strInput)) > 0 Then
          If objFSO.FileExists(strNewFile) Then
             DocSkipCnt = DocSkipCnt + 1
          Else
            'objFSO.CopyFile (strFullPath), strNewFile
            objFSO.MoveFile (strFullPath), strNewFile
    		cntFileMove = cntFileMove + 1
          End If 'for FileExist
      End If 'for inStr
      
      Next
       
    Wscript.Echo "Knightster Wow! It Finished - " & Now() & vbCrLf & "Records Searched: " _
                               & Right(String(6, "0") & CStr(cntFileID), 6) _
    			   & vbCrLf & "Records Moved: " _
    			   & Right(String(6, "0") & CStr(cntFileMove), 6) _
                               & vbCrLf & "Docs Exist Skipped: : " & DocSkipCnt
      Else 'bad search
        MsgBox Msg3, vbOKOnly, MsgTitle
     End IF 'bad search
    Else
     MsgBox Msg2, vbOKOnly, MsgTitle
    End If 'stop this now -
    
    WScript.Quit
     
  13. Knightster

    Knightster Thread Starter

    Joined:
    Jan 22, 2015
    Messages:
    11
    I've moved the commented (tick mark) line as you detailed above , and now the files are only moved, Perfect !! :) Thanks Dan...
     
  14. Knightster

    Knightster Thread Starter

    Joined:
    Jan 22, 2015
    Messages:
    11
    Many Thanks Dan, you've been a diamond !!
     
  15. draceplace

    draceplace

    Joined:
    Jun 8, 2001
    Messages:
    2,583
    I meant to use MsgTitleBad in this piece..its cosmetic
    Else 'bad search
    MsgBox Msg3, vbOKOnly, MsgTitleBad
    End IF 'bad search
     
  16. Sponsor

As Seen On
As Seen On...

Welcome to Tech Support Guy!

Are you looking for the solution to your computer problem? Join our site today to ask your question. This site is completely free -- paid for by advertisers and donations.

If you're not already familiar with forums, watch our Welcome Guide to get started.

Join over 733,556 other people just like you!

Loading...
Thread Status:
Not open for further replies.

Short URL to this thread: https://techguy.org/1141702

  1. This site uses cookies to help personalise content, tailor your experience and to keep you logged in if you register.
    By continuing to use this site, you are consenting to our use of cookies.
    Dismiss Notice