Option Explicit
Public Function DeleteFile(ByVal aFullPath As String) As Boolean
On Error GoTo Err
If InStr(aFullPath, "\") = 0 Then aFullPath = CurDir & "\" & aFullPath
If Not ExistsFile(aFullPath) Then GoTo Warn
Kill aFullPath
DeleteFile = True
If logging Then AddLog "FileUtil.DeleteFile", "INFO ", "対象:" & aFullPath
Exit Function
Warn:
DeleteFile = True
If logging Then AddLog "FileUtil.DeleteFile", "WARN ", "対象:" & aFullPath & " / 警告内容:ファイルが存在しません"
Exit Function
Err:
If logging Then AddLog "FileUtil.DeleteFile", "ERROR", "対象:" & aFullPath & " / エラー内容:" & Err.Description
End Function
Public Function CopyFile(ByVal aOrigin As String, ByVal aDestination As String, Optional aIsOverWrite As Boolean) As Boolean
On Error GoTo Err
If InStr(aOrigin, "\") = 0 Then aOrigin = CurDir & "\" & aOrigin
If InStr(aDestination, "\") = 0 Then aDestination = CurDir & "\" & aDestination
If Not aIsOverWrite Then
If ExistsFile(aDestination) Then GoTo Err
End If
FileCopy aOrigin, aDestination
CopyFile = True
If logging Then AddLog "FileUtil.CopyFile", "INFO ", "コピー元:" & aOrigin & " / コピー先:" & aDestination & " / 上書き:" & aIsOverWrite
Exit Function
Err:
If logging Then AddLog "FileUtil.CopyFile", "ERROR", "コピー元:" & aOrigin & " / コピー先:" & aDestination & " / 上書き:" & aIsOverWrite & " / エラー内容:" & Err.Description
End Function
Public Function MoveFile(ByVal aSource As String, ByVal aDestination As String) As Boolean
On Error GoTo Err
Dim fso As Object: Set fso = CreateObject("Scripting.FileSystemObject")
If InStr(aSource, "\") = 0 Then aSource = CurDir & "\" & aSource
If InStr(aDestination, "\") = 0 Then aDestination = CurDir & "\" & aDestination
fso.MoveFile aSource, aDestination
MoveFile = True
If logging Then AddLog "FileUtil.MoveFile", "INFO ", "移動元:" & aSource & " / 移動先:" & aDestination
GoTo Finally
Err:
If logging Then AddLog "FileUtil.MoveFile", "ERROR", "移動元:" & aSource & " / 移動先:" & aDestination & " / エラー内容:" & Err.Description
Finally:
Set fso = Nothing
End Function
Public Function ChangeFileName(ByVal aFullPath As String, aFileName As String) As Boolean
On Error GoTo Err
Dim fso As Object: Set fso = CreateObject("Scripting.FileSystemObject")
If InStr(aFullPath, "\") = 0 Then aFullPath = CurDir & "\" & aFullPath
fso.GetFile(aFullPath).name = aFileName
ChangeFileName = True
If logging Then AddLog "FileUtil.ChangeFileName", "INFO ", "対象:" & aFullPath & " / ファイル名:" & aFileName
GoTo Finally
Err:
If logging Then AddLog "FileUtil.ChangeFileName", "ERROR", "対象:" & aFullPath & " / ファイル名:" & aFileName & " / エラー内容:" & Err.Description
Finally:
Set fso = Nothing
End Function
Public Function WriteText(ByVal aFullPath As String, aValue As Variant, Optional aCharset As String = "UTF-8", Optional aIsOverWrite As Boolean) As Boolean
On Error GoTo Err
Dim writeValue As String
Dim ado As Object: Set ado = CreateObject("ADODB.Stream")
With ado
.Open
.charset = aCharset
.Type = 2
End With
If InStr(aFullPath, "\") = 0 Then aFullPath = CurDir & "\" & aFullPath
Dim v As Variant
If IsArray(aValue) Or IsObject(aValue) Then
For Each v In aValue
writeValue = writeValue & v & vbLf
Next
Else
writeValue = aValue & vbLf
End If
Dim overWrite As Long: overWrite = IIf(aIsOverWrite, 2, 1)
If ExistsFile(aFullPath) Then
With ado
.LoadFromFile aFullPath
.Position = .Size
.WriteText writeValue, 0
.SaveToFile aFullPath, overWrite
End With
Else
With ado
.WriteText writeValue, 0
.SaveToFile aFullPath, 1
End With
End If
WriteText = True
If logging Then AddLog "FileUtil.WriteText", "INFO ", "対象:" & aFullPath & " / 文字コード:" & aCharset
GoTo Finally
Err:
If logging Then AddLog "FileUtil.WriteText", "ERROR", "対象:" & aFullPath & " / 文字コード:" & aCharset & " / エラー内容:" & Err.Description
Finally:
ado.Close
End Function
Public Function WriteTextByDialog(aValue As Variant, Optional aCharset As String = "UTF-8", Optional aIsOverWrite As Boolean) As Boolean
On Error GoTo Err
Dim writeValue As String
Dim fullPath As String
Dim ado As Object: Set ado = CreateObject("ADODB.Stream")
With ado
.Open
.charset = aCharset
End With
fullPath = Application.GetSaveAsFilename()
If fullPath = "False" Then GoTo Err
Dim v As Variant
If IsArray(aValue) Or IsObject(aValue) Then
For Each v In aValue
writeValue = writeValue & v & vbLf
Next
Else
writeValue = aValue & vbLf
End If
Dim overWrite As Long: overWrite = IIf(aIsOverWrite, 2, 1)
If ExistsFile(fullPath) Then
With ado
.LoadFromFile fullPath
.Position = .Size
.WriteText writeValue, 0
.SaveToFile fullPath, overWrite
End With
Else
With ado
.WriteText writeValue, 0
.SaveToFile fullPath, 1
End With
End If
WriteTextByDialog = True
If logging Then AddLog "FileUtil.WriteTextByDialog", "INFO ", "対象:" & fullPath & " / 文字コード:" & aCharset
GoTo Finally
Err:
If logging Then AddLog "FileUtil.WriteTextByDialog", "ERROR", "対象:" & fullPath & " / 文字コード:" & aCharset & " / エラー内容:" & Err.Description
Finally:
ado.Close
End Function
Public Function ReadText(ByVal aFullPath As String, aReturn As Collection, Optional aCharset As String = "UTF-8") As Boolean
On Error GoTo Err
Dim ado As Object: Set ado = CreateObject("ADODB.Stream")
With ado
.Open
.charset = aCharset
.LineSeparator = 10
End With
If InStr(aFullPath, "\") = 0 Then aFullPath = CurDir & "\" & aFullPath
ado.LoadFromFile aFullPath
Do Until ado.EOS
aReturn.Add ado.ReadText(-2)
Loop
ReadText = True
If logging Then AddLog "FileUtil.ReadText", "INFO ", "対象:" & aFullPath & " / 文字コード:" & aCharset
GoTo Finally
Err:
If logging Then AddLog "FileUtil.ReadText", "ERROR", "対象:" & aFullPath & " / 文字コード:" & aCharset & " / エラー内容:" & Err.Description
Finally:
ado.Close
End Function
Public Function ReadTextByDialog(aReturn As Collection, Optional aCharset As String = "UTF-8") As Boolean
On Error GoTo Err
Dim ado As Object: Set ado = CreateObject("ADODB.Stream")
Dim fullPath As String
With ado
.Open
.charset = aCharset
.LineSeparator = 10
End With
fullPath = Application.GetOpenFilename()
If fullPath = "False" Then GoTo Err
ado.LoadFromFile fullPath
Do Until ado.EOS
aReturn.Add ado.ReadText(-2)
Loop
ReadTextByDialog = True
If logging Then AddLog "FileUtil.ReadTextByDialog", "INFO ", "対象:" & fullPath & " / 文字コード:" & aCharset
GoTo Finally
Err:
If logging Then AddLog "FileUtil.ReadTextByDialog", "ERROR", "対象:" & fullPath & " / 文字コード:" & aCharset & " / エラー内容:" & Err.Description
Finally:
ado.Close
End Function
Public Function FullPathToName(aFullPath As String, Optional aIsExtension As Boolean = True) As String
Dim fso As Object: Set fso = CreateObject("Scripting.FileSystemObject")
FullPathToName = IIf(aIsExtension, fso.GetFileName(aFullPath), fso.GetBaseName(aFullPath))
End Function
Public Function GetFileList(Optional ByVal aPath As String, Optional aLikeValue As String, Optional aIsFullPath As Boolean) As Collection
Dim fso As Object: Set fso = CreateObject("Scripting.FileSystemObject")
Dim f As Variant
Set GetFileList = New Collection
If aPath = "" Then aPath = CurDir
For Each f In fso.GetFolder(aPath).Files
If aLikeValue = "" Or LCase(f.name) Like aLikeValue Then
If aIsFullPath Then GetFileList.Add f.Path
If Not aIsFullPath Then GetFileList.Add f.name
End If
Next
End Function
Public Function ExistsFile(aFullPath As String) As Boolean
If (Dir(aFullPath) <> "") Then ExistsFile = True
End Function