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.
