文件移动/复制 源文件夹到目标文件夹

• 下载 move.zip - 844.3 KB

引言

这是一个实用软件，用于将源文件夹中的文件移动到目标文件夹。

使用代码

文件移动实用程序用于将文件从源文件夹移动到目标文件夹，它没有界面，将在内部工作。
在 bin 文件夹中，GetPath.xml 用于指示源路径和目标路径，另一个属性 fileCount 用于指示将移动多少个文件。

其他功能是错误日志，如果存在任何错误，则会将错误描述添加到 ErrorLog.txt 中，然后程序将终止。

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

历史

在此处保持您所做的任何更改或改进的实时更新。