Option Explicit
' ▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽
' Excel对象
' △△△△△△△△△△△△△△△△△△
' Open
Public Function FileOpen_ByExcel(ByVal FileName As String, ByRef Target As Workbook) As Boolean
On Error GoTo OpenFileError
Set Target = Workbooks.Open(FileName:=FileName, ReadOnly:=False)
FileOpen_ByExcel = True
Exit Function
OpenFileError:
FileOpen_ByExcel = False
End Function
' Save
Public Function FileSave_ByExcel(ByVal FileName As String, ByVal Target As Workbook) As Boolean
On Error GoTo SaveFileError
If FileName = "" Then
Target.Save
Else
Target.SaveAs FileName:=FileName
End If
FileSave_ByExcel = True
Exit Function
SaveFileError:
FileSave_ByExcel = False
End Function
' Close
Public Function FileClose_ByExcel(ByVal Target As Workbook) As Boolean
On Error GoTo FileCloseError
Target.Close savechanges:=False
FileClose_ByExcel = True
Exit Function
FileCloseError:
FileClose_ByExcel = False
End Function
' ▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽
' FileSystemObject
' △△△△△△△△△△△△△△△△△△
' Folder
' CreateFolder
Public Function FolderCreate_ByFSO(ByVal FolderName As String, ByVal DeleteFlg As Boolean) As Boolean
Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
On Error GoTo FolderCreateError
If FSO.FolderExists(FolderName) Then
If DeleteFlg Then
FSO.DeleteFolder (FolderName)
Else
Set FSO = Nothing
FolderCreate_ByFSO = True
Exit Function
End If
End If
Dim ParentFolderName As String
ParentFolderName = FSO.GetParentFolderName(FolderName)
If FSO.FolderExists(ParentFolderName) = False Then
If FolderCreate_ByFSO(ParentFolderName, False) = False Then
GoTo FolderCreateError
End If
End If
FSO.CreateFolder (FolderName)
Set FSO = Nothing
FolderCreate_ByFSO = True
Exit Function
FolderCreateError:
Set FSO = Nothing
FolderCreate_ByFSO = False
End Function
' CreateFile
Public Function FileCreate_ByFSO(ByVal FileName As String, ByVal DeleteFlg As Boolean) As Boolean
Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
On Error GoTo FileCreateError
If FSO.FileExists(FileName) Then
If DeleteFlg Then
FSO.DeleteFile (FileName)
Else
Set FSO = Nothing
FileCreate_ByFSO = True
Exit Function
End If
End If
Dim ParentFolderName As String
ParentFolderName = FSO.GetParentFolderName(FileName)
If FSO.FolderExists(ParentFolderName) = False Then
If FolderCreate_ByFSO(ParentFolderName, False) = False Then
GoTo FileCreateError
End If
End If
FSO.CreateTextFile (FileName)
Set FSO = Nothing
FileCreate_ByFSO = True
Exit Function
FileCreateError:
Set FSO = Nothing
FileCreate_ByFSO = False
End Function
'
'' OpenTextFile
'Public Function OpenTextFile_ByFSO(ByVal FileName As String) As String
'
' Const ForReading As Integer = 1
' Const CreateFlgFalse As Boolean = False
'
' Dim FSO As Object, TextFile As Object, TextStr As String
' Set FSO = CreateObject("Scripting.FileSystemObject")
'
' On Error GoTo OpenTextFileError
'
' Set TextFile = FSO.OpenTextFile(FileName, ForReading, CreateFlgFalse)
' TextStr = TextFile.Readall
'
' TextFile.Close
' Set FSO = Nothing
'
' OpenTextFile_ByFSO = TextStr
' Exit Function
'
'OpenTextFileError:
'
' TextFile.Close
' Set FSO = Nothing
' OpenTextFile_ByFSO = ""
'
'End Function
'
'' OpenTextFile
'Public Function WriteTextFile_ByFSO(ByVal FileName As String, ByVal Buffer As String) As Boolean
'
' If FileCreate_ByFSO(FileName, True) = False Then
' WriteTextFile_ByFSO = False
' Exit Function
' End If
'
' Const ForWriting As Integer = 2
' Const CreateFlgTrue As Boolean = True
'
' Dim FSO As Object, TextFile As Object
' Set FSO = CreateObject("Scripting.FileSystemObject")
'
' On Error GoTo OpenTextFileError
'
' Set TextFile = FSO.OpenTextFile(FileName, ForWriting, CreateFlgTrue)
' TextFile.Write (Buffer)
'
' TextFile.Close
' Set FSO = Nothing
'
' WriteTextFile_ByFSO = True
' Exit Function
'
'OpenTextFileError:
'
' TextFile.Close
' Set FSO = Nothing
' WriteTextFile_ByFSO = False
'
'End Function
Public Function OpenTextFile_ByADODBStream(FileName As String) As String
Dim FileBody As String
Dim ADODBStream As Object
Set ADODBStream = CreateObject("ADODB.Stream")
With ADODBStream
.Type = 1
.Mode = 3
.Open
.LoadFromFile FileName
.Position = 0
.Type = 2
.Charset = "utf-8"
FileBody = .ReadText
.Close
End With
Set ADODBStream = Nothing
OpenTextFile_ByADODBStream = FileBody
End Function
' WriteTextFile_ByADODBStream
Public Function WriteTextFile_ByADODBStream(ByVal OutFileName As String, ByVal Buffer As String) As Boolean
If FileCreate_ByFSO(OutFileName, True) = True Then
Dim ADODBStream As Object
Set ADODBStream = CreateObject("ADODB.Stream")
'
With ADODBStream
.Type = 2
.Charset = "utf-8"
.Open
.WriteText Buffer, 1
.SaveToFile OutFileName, 2
.Close
End With
Set ADODBStream = Nothing
WriteTextFile_ByADODBStream = True
Else
WriteTextFile_ByADODBStream = False
End If
End Function
'
' log
'
Public Function WriteLog(ByVal LogFilePath As String, ByVal msg As String)
Dim FSO As Object, LOG As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
'
If FSO.FileExists(LogFilePath) = False Then
FSO.CreateTextFile (LogFilePath)
End If
'
Set LOG = FSO.OpenTextFile(LogFilePath, 8)
'
LOG.WriteLine Now & vbTab & msg
Set LOG = Nothing
Set FSO = Nothing
End Function
