VB code to select and move file from dir to dir

Status
This thread has been Locked and is not open to further replies. Please start a New Thread if you're having a similar issue. View our Welcome Guide to learn how to use this site.

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 !!
 
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
 
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.
 

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

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 ?
 

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 :)
 
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
 
Joined
Jun 8, 2001
Messages
2,583
You are welcome, glad to help. Feel free to post back with additional question concerning the code.
 

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

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...
 
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
 
Status
This thread has been Locked and is not open to further replies. Please start a New Thread if you're having a similar issue. View our Welcome Guide to learn how to use this site.

Users Who Are Viewing This Thread (Users: 0, Guests: 1)

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 807,865 other people just like you!

Latest posts

Members online

Top