VBA文件处理

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 = NothingEnd Function