Const ForReading = 1, ForWriting = 2, ForAppending = 8
'Overview: Display the folder selection dialog and select a folder
'Arguments: None
'Return value: getFilePath Selected path
Function getFilePath() As String
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
With fd
.Title = "Open folder"
If .Show = -1 Then
getFilePath= .SelectedItems(1)
End If
End With
End Function
'Summary: Read the specified line number
'Argument: strRowNo Row number
'Return value: readRowNo Contents of the specified row
Function readRowNo(strPath As String, strRowNo As Integer) As String
Dim FileObj
Dim FilePath
Dim strNY As String
Set FileObj = CreateObject("Scripting.FileSystemObject")
Set File = FileObj.openTextFile(strPath, 1)
For i = 1 To strRowNo
File.SkipLine
Next
readRowNo = File.readLine
File.Close
Set File = Nothing
Set FileObj = Nothing
End Function
'Overview: Get a list of files in a folder (all files) (including subfolders)
'Arguments: strInPath path, arrOutput Array to return
'Return value: makeFileList "true: with file, false: without file"
Function makeFileList(strInPath As String, arrOutput() As String) As Boolean
Dim fso As Object
Dim fd As Object
makeFileList = False
ReDim arrOutput (0)
Set fso = CreateObject("Scripting.FileSystemObject")
Set fd = fso.GetFolder(strInPath)
searchFiles fd, arrOutput
Set fso = Nothing
Set fd = Nothing
If 0 < UBound(arrOutput, 1) Then
ReDim Preserve arrOutput (UBound (arrOutput, 1) - 1)
Else
Exit Function
End If
makeFileList = True
End Function
'Overview: Get a list of files (specified extension) in a folder (including subfolders)
'Arguments: strInPath: path, strFileType: file type, arrOutput Array to return
'Return value: makeFileList "true: with file, false: without file"
Function makeFileList(strInPath As String, strFileType As String, arrOutput() As String) As Boolean
Dim fso As Object
Dim fd As Object
makeFileList = False
ReDim arrOutput (0)
Set fso = CreateObject("Scripting.FileSystemObject")
Set fd = fso.GetFolder(strInPath)
searchFiles fd, strFileType, arrOutput
Set fso = Nothing
Set fd = Nothing
If 0 < UBound(arrOutput, 1) Then
ReDim Preserve arrOutput (UBound (arrOutput, 1) - 1)
Else
Exit Function
End If
makeFileList = True
End Function
'Overview: Get a list of files (all files) in a folder
'Arguments: fd folder target, arrOutput array to return
'Return value: searchFiles "true: with file, false: without file"
Function searchFiles(fd As Object, arrOutput() As String) As Boolean
Dim fl As Object
Dim sfd As Object
searchFiles = False
For Each fl In fd.Files
ReDim Preserve arrOutput (UBound (arrOutput, 1) + 1)
arrOutput(UBound(arrOutput, 1) - 1) = fl.Path
Next fl
If fd.SubFolders.Count = 0 Then
Exit Function
End If
For Each sfd In fd.SubFolders
searchFiles sfd, strFileType, arrOutput
Next
Set sfd = Nothing
searchFiles = True
End Function
'Overview: Get the list of files (specified extension) in the folder
'Arguments: fd folder target, strFileType: file type, arrOutput array to return
'Return value: searchFiles "true: with file, false: without file"
Function searchFiles(fd As Object, strFileType As String, arrOutput() As String) As Boolean
Dim fl As Object
Dim sfd As Object
Dim sTmp As String
sTmp = ""
searchFiles = False
sTmp = Split(strFileType, ".")(1)
sTmp = "." & sTmp
For Each fl In fd.Files
If UCase(Right(fl.Path, Len(sTmp))) = UCase(sTmp) Then
ReDim Preserve arrOutput (UBound (arrOutput, 1) + 1)
arrOutput(UBound(arrOutput, 1) - 1) = fl.Path
End If
Next fl
If fd.SubFolders.Count = 0 Then
Exit Function
End If
For Each sfd In fd.SubFolders
searchFiles sfd, strFileType, arrOutput
Next
Set sfd = Nothing
searchFiles = True
End Function
'Summary: Get file contents
'Arguments: strFileName file name, arrContent file full-text array
'Return value: readFile "true: normal, false: abnormal"
Function readFile(strFileName As String, arrContent As Variant) As Boolean
Dim fso As Object
Dim sFile As Object
readFile = False
If isFileExists(strFileName) Then
'NULL
Else
Exit Function
End If
ReDim arrContent(0)
Set fso = CreateObject("Scripting.FileSystemObject")
Set sFile = fso.openTextFile(strFileName, 1)
Do While Not sFile.AtEndOfStream
ReDim Preserve arrContent(UBound(arrContent, 1) + 1)
arrContent(UBound(arrContent, 1) - 1) = sFile.readLine
Loop
sFile.Close
Set fso = Nothing
Set sFile = Nothing
If 0 < UBound(arrContent, 1) Then
ReDim Preserve arrContent(UBound(arrContent, 1) - 1)
Else
Exit Function
End If
readFile = True
End Function
'Summary: Judge file existence
'Argument: strFileName File name
'Return value: isFileExists "true: exists, false: does not exist"
Function isFileExists(strFileName As String) As Boolean
Dim fs As Object
Set fs = CreateObject("Scripting.FileSystemObject")
If fs.FileExists(strFileName) Then
isFileExists = True
Else
isFileExists = False
End If
Set fs = Nothing
End Function
'Summary: Fill in the file
'Arguments: strFileName: File name, arrContent: Content you want to fill in, intIoMode: Processing mode, booCreate: File does not exist "true: Create, false: Do not create"
'Return value: None
Function writeFile(strFileName As String, arrContent() As String, _
ByVal intIoMode As integer, ByVal booCreate As Boolean) As Boolean
Dim fso As Object
Dim sFile As Object
Dim i As Long
i = 0
writeFile = False
Set fso = CreateObject("Scripting.FileSystemObject")
Select Case intIoMode
Case 8'added
Set sFile = fso.openTextFile(strFileName, 8, booCreate)
Case 1'Read
Set sFile = fso.openTextFile(strFileName, 1, booCreate)
Case 2'write
Set sFile = fso.openTextFile(strFileName, 2, booCreate)
End Select
For i = 0 To UBound(arrContent, 1)
sFile.writeLine (arrContent(i))
Next i
sFile.Close
Set fso = Nothing
Set sFile = Nothing
writeFile = True
End Function
'Summary: Fill in the log title
'Argument: strOutFile Target file name
'Return value: None
Function writeLogHeader(strOutFile As String)
Dim cOutput() As String
ReDim cOutput(0)
'Specify the title
cOutput(0) = """" & "No." & """" & vbTab
cOutput(0) = cOutput(0) & """" & "Source File" & """" & vbTab
cOutput(0) = cOutput(0) & """" & "Row Number" & """" & vbTab
cOutput(0) = cOutput(0) & """" & "Row Infor" & """"
Call writeFile(strOutFile, cOutput, ForAppending, True)
End Function
'Summary: Fill in the log text
'Arguments: strOutFile: filename, lNum: order, strSrcFile: source file, lngRownum: row number, strRowContent: row text
'Return value: None
Function writeLog(strOutFile As String, lNum As Long, strSrcFile As String, lngRownum As Long, strRowContent As String)
Dim cOutput() As String
ReDim cOutput(0)
cOutput(0) = Chr(34) & lNum & Chr(34) & vbTab
cOutput(0) = cOutput(0) & Chr(34) & strSrcFile & Chr(34) & vbTab
cOutput(0) = cOutput(0) & Chr(34) & lngRownum & Chr(34) & vbTab
'cOutput(0) = cOutput(0) & Chr(34) & strRowContent & Chr(34)
cOutput(0) = cOutput(0) & strRowContent
Call writeFile(strOutFile, cOutput, ForAppending, True)
End Function
'Summary: Delete the file with the specified path
'Arguments: strFilePath: Target path
'Return value: true: operation successful, false: operation failure
Function deleteAllFiles(ByVal strFilePath As String) As Boolean
Dim arrOutput() As String
Call makeFileList(strFilePath, arrOutput)
For i = 0 To UBound(arrOutput)
If isFileExists(arrOutput(i)) Then
Kill arrOutput(i)
End If
Next i
deleteAllFiles = True
End Function