File moving/copying source folfer to destination folder

• Download move.zip - 844.3 KB

Introduction

Its a utility software for using file moving source folder to destination folder.

Using the code

File move utility is used for moving file source to destination folder, There is no interface, it will work internally.
In bin folder one GetPath.xml used for Indicating source and destination path other one attributes fileCount is used for indicating that how much file will be move

Other functionality is error log if any error persist then error description is added on ErrorLog.txt, and then it will terminating.

Option Explicit On 
Module Module1

Private Declare Function MoveFile Lib "kernel32" _
Alias "MoveFileA" (ByVal lpExistingFileName As String, _
ByVal lpNewFileName As String, ByVal bFailIfExists As Long) _
As Long

Dim bSuccess As Boolean
Dim FileName As String
Dim lstSourceFile As String, lstDestFile As String
Dim lstDestn As String, lstSource As String
Dim lstDestnPath As String, lstSourcePath As String
Dim xmlDoc As New MSXML2.DOMDocument30
Dim objNodeList As MSXML2.IXMLDOMNodeList
Dim objSrcNode As MSXML2.IXMLDOMNode
Dim objDstNode As MSXML2.IXMLDOMNode
Dim objFileNode As MSXML2.IXMLDOMNode
Dim iCount As Integer
Dim lintFileCount As Integer

Sub Main()

On Error Resume Next
'*******************************************************************************
' XML Code Start
'*******************************************************************************

xmlDoc.load("GetPath.xml")
objNodeList = xmlDoc.selectNodes("//Path")
objSrcNode = xmlDoc.selectSingleNode("//SourcePath")
objDstNode = xmlDoc.selectSingleNode("//DestnPath")
objFileNode = xmlDoc.selectSingleNode("//FileCount")
lstSource = (objSrcNode.text)
lstDestn = (objDstNode.text)
lintFileCount = CInt(objFileNode.text)
'*******************************************************************************
' XML Code End
'*******************************************************************************

If Err.Number <> 0 Then
    Call ErrorDescription(Err.Description, "Xml Integration")
End If
    Call FunIsCSVExist()
End Sub

'********************************************************************
'Private Function AppPath() As String
' Return System.Windows.Forms.Application.StartupPath
'End Function
'********************************************************************


' Function checking is any csv exist in destination folder 
Sub FunIsCSVExist()
On Error Resume Next
    lstSourceFile = Dir(lstSource)
    lstDestFile = Dir(lstDestn)
If ((lstDestFile = vbNullString) And (lstSourceFile <> vbNullString)) Then
    Call FunCheckForCopy()
End If
    If Err.Number <> 0 Then
        Call ErrorDescription(Err.Description, "Checking destination folder")
    End If
End Sub
'Function CheckExtension(ByVal lszFile)
' Dim lszFromRight As String
' Dim lszFileIndex As Integer
' Dim lszFileExtn As String
' lszFromRight = Right(lszFile, 5)
' lszFileIndex = InStr(lszFromRight, ".")
' lszFileExtn = Mid(lszFromRight, CInt(lszFileIndex) + 1, Len(lszFromRight))
' CheckExtension = lszFileExtn
'End Function

Sub FunCheckForCopy()
iCount = 0
On Error Resume Next
FileName = Dir(lstSource)
Do While FileName <> vbNullString
lstSourcePath = lstSource & FileName
lstDestnPath = lstDestn & FileName
If iCount >= lintFileCount Then
Exit Do
Else
bSuccess = APIFileCopy(lstSourcePath, lstDestnPath, True)
End If
iCount = iCount + 1
FileName = Dir()
Loop
If Err.Number <> 0 Then
Call ErrorDescription(Err.Description, "Checking First File for moveing")
End If
End Sub
Public Function APIFileCopy(ByVal src As String, ByVal dest As String, ByVal FailIfDestExists As Boolean) As Boolean
Dim lRet As Long
'Commented part is used for copy
'lRet = CopyFile(src, dest, FailIfDestExists)
lRet = MoveFile(src, dest, FailIfDestExists)
APIFileCopy = (lRet > 0)
End Function
Sub ErrorDescription(ByVal Erordesc, ByVal ErSource)
Dim ScriptObject = New Scripting.FileSystemObject
Dim lstrErrorLogFileName As String
Dim errorLogFile = New Scripting.FileSystemObject
lstrErrorLogFileName = "ErrorLog.txt"
If ScriptObject.FileExists(lstrErrorLogFileName) Then
errorLogFile = ScriptObject.OpenTextFile(lstrErrorLogFileName, 8)
Else
errorLogFile = ScriptObject.CreateTextFile(lstrErrorLogFileName)
End If
errorLogFile.WriteLine("--------------------------------------------------------------------------------------------")
errorLogFile.WriteLine("Date: " & Now())
errorLogFile.WriteLine("Error No: " & Err.Number)
errorLogFile.WriteLine("Error Description: " & Erordesc)
errorLogFile.WriteLine("Error Source: " & ErSource)
errorLogFile.Close()
Err.Clear()
End
End Sub

End Module

History

Keep a running update of any changes or improvements you've made here.