'/**
' * フォルダ選択ダイアログ
' */
Public Function GetFolder() As String
GetFolder = ""
Dim Shell, myPath
Set Shell = CreateObject("Shell.Application")
Set myPath = Shell.browseForFolder(&O0, "SQL出力DIR", &H1 + &H10, "")
If Not myPath Is Nothing Then
GetFolder = myPath.items.Item.path
End If
Set myPath = Nothing
Set Shell = Nothing
End Function
'/**
' * Excelファイル選択ダイアログ
' */
Public Function GetExcel() As String
GetExcel = ""
Dim path As String
path = Application.GetOpenFilename( _
filefilter:="Excel(*.xlsx),*.xlsx" _
, FilterIndex:=1 _
, Title:="DB定義書を選択" _
, MultiSelect:=False _
)
If path <> "False" Then
GetExcel = path
End If
End Function
'/**
' * Excelファイル複数選択ダイアログ
' */
Public Function GetExcelList() As Variant
GetExcelList = ""
Dim excelList As Variant
excelList = Application.GetOpenFilename( _
filefilter:="Excel(*.xlsx),*.xlsx" _
, FilterIndex:=1 _
, Title:="DB定義書を選択" _
, MultiSelect:=True _
)
If IsArray(excelList) Then
GetExcelList = excelList
End If
End Function
'/**
' * ファイルパスからファイル名を取得
' */
Public Function GetFileName(ByVal path As String) As String
GetFileName = ""
Dim tmp As Variant
tmp = Split(path, "\")
GetFileName = tmp(UBound(tmp))
End Function
'/**
' * ファイル出力(UTF-8 BOMなし)
' */
Public Function OutputFileUtf8(ByVal path As String, ByVal str As String) As Boolean
On Error GoTo exception
OutputFileUtf8 = False
Dim streamWriterTmp As Object
Dim streamWriter As Object
Set streamWriterTmp = CreateObject("ADODB.Stream")
streamWriterTmp.Type = 2 '//テキストモード
streamWriterTmp.Charset = "UTF-8"
streamWriterTmp.Open
streamWriterTmp.WriteText str
'// バイナリモードに変更
streamWriterTmp.Position = 0
streamWriterTmp.Type = 1
'// BOM(3byte)をスキップしてbufferに読み込む
Dim buffer As Variant
streamWriterTmp.Position = 3
buffer = streamWriterTmp.Read
streamWriterTmp.Close
Set streamWriter = CreateObject("ADODB.Stream")
streamWriter.Type = 1
streamWriter.Open
streamWriter.Write buffer
streamWriter.SaveToFile path, 2
streamWriter.Close
OutputFileUtf8 = True
GoTo finally
exception:
OutputFileUtf8 = False
Call Logger.error("CommonUtil#OutputFileUtf8", Err.Description)
finally:
Set streamWriterTmp = Nothing
Set streamWriter = Nothing
End Function
