Malicious Office (OLE) — malware analysis report

Attribute VB_Name = "ThisWorkbook"
Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True
Option Explicit


Attribute VB_Name = "Sheet1"
Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True
Option Explicit


Attribute VB_Name = "添付"
Attribute VB_Base = "0{2F48A556-F978-4A67-834B-0D2E8A4D7E7A}{E8B1F2F7-9E0B-4681-A03B-3B819939B1B9}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False
Option Explicit
Private mHokenKbn As KB_HOKEN
Private mSinseiKbn As KEISIKI_SINSEI
Private mNeedLog As Boolean
Private mProcName As String
Private mCompanyAccount As String
Private mGuid As String
Private mTargetName As String
Public mwb As Workbook
Private Cmd(0 To 9) As CAttachControl
Public Property Get SinseiKbn() As KEISIKI_SINSEI
    
    SinseiKbn = mSinseiKbn

End Property
Public Property Let SinseiKbn(ByVal vNewValue As KEISIKI_SINSEI)
    
    mSinseiKbn = vNewValue
    
End Property
Public Property Let HokenKbn(ByVal vNewValue As KB_HOKEN)
    
    mHokenKbn = vNewValue
    
End Property
Public Property Get HokenKbn() As KB_HOKEN
    
    HokenKbn = mHokenKbn

End Property
Public Property Let needLog(ByVal vNewValue As Boolean)
    
    mNeedLog = vNewValue
    
    Dim i As Long

    For i = 0 To 9
        Cmd(i).needLog = mNeedLog
    Next i
    
End Property
Public Property Let ProcName(ByVal vNewValue As String)
    
    mProcName = vNewValue
    
    Dim i As Long

    For i = 0 To 9
        Cmd(i).ProcName = mProcName
    Next i
    
End Property
Public Property Let CompanyAccount(ByVal vNewValue As String)
    
    mCompanyAccount = vNewValue
    
    Dim i As Long

    For i = 0 To 9
        Cmd(i).CompanyAccount = mCompanyAccount
    Next i
    
End Property
Public Property Let guid(ByVal vNewValue As String)
    
    mGuid = vNewValue
    
    Dim i As Long

    For i = 0 To 9
        Cmd(i).guid = mGuid
    Next i
    
End Property
Public Property Let TargetName(ByVal vNewValue As String)
    
    mTargetName = vNewValue
    
    Dim i As Long

    For i = 0 To 9
        Cmd(i).TargetName = mTargetName
    Next i
    
End Property
Private Sub UserForm_Initialize()

    Dim i As Long

    For i = 0 To 9
        Set Cmd(i) = New CAttachControl
        Cmd(i).PreviewButton = Me.Controls("cmdPre" & (i + 1))
        Cmd(i).TextObj = Me.Controls("Text" & (i + 1))
    Next i

End Sub
Private Sub UserForm_Activate()

        Dim i As Long
        With mwb.Worksheets("DATA")
            For i = 0 To 9
                If mSinseiKbn = KOBETU Then
                    Controls("Text" & i + 1).value = .Cells(122 + i * 3, 2).value
                    Controls("Text" & i + 1).ControlTipText = .Cells(122 + i * 3, 2).value 'YBNO20196
                ElseIf mSinseiKbn = HYOJYUN Then
                    Controls("Text" & i + 1).value = .Cells(62 + i, 4).value
                    Controls("Text" & i + 1).ControlTipText = .Cells(62 + i, 4).value 'YBNO20196
                End If
            Next
        End With

End Sub
Private Sub CommandButton1_Click()

        Call ファイル開く(1)

End Sub
Private Sub CommandButton2_Click()

        Call ファイル開く(2)

End Sub
Private Sub CommandButton3_Click()

         Call ファイル開く(3)

End Sub
Private Sub CommandButton4_Click()

         Call ファイル開く(4)

End Sub
Private Sub CommandButton5_Click()

         Call ファイル開く(5)

End Sub
Private Sub CommandButton6_Click()

        Call ファイル開く(6)

End Sub
Private Sub CommandButton7_Click()

        Call ファイル開く(7)

End Sub
Private Sub CommandButton8_Click()

        Call ファイル開く(8)

End Sub
Private Sub CommandButton9_Click()

        Call ファイル開く(9)

End Sub
Private Sub CommandButton10_Click()

        Call ファイル開く(10)

End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

        Dim i As Long
'#37486 hara 20170714 入力したファイルが全て存在するかチェックする
        Dim FSO As Object
        Dim path As String
        Set FSO = CreateObject("Scripting.FileSystemObject")
        
        For i = 0 To 9
            path = Controls("Text" & i + 1).value
            If Trim(path) <> "" Then
                If FSO.FileExists(path) <> True Then
                    MsgBox i + 1 & "番目のファイルが見つかりません。" & vbCrLf & "パスを確認してください。", vbOKOnly + vbCritical, "添付ファイルチェック"
                    Cancel = True
                End If
            End If
        Next
'#37486 ここまで
        Application.Calculation = xlManual

        With mwb.Worksheets("DATA")
            If mSinseiKbn = KOBETU Then
                For i = 0 To 9
                    If Controls("Text" & i + 1).value <> "" Then
                    .Cells(120 + i * 3, 2).value = Dir(Controls("Text" & i + 1).value)
                    .Cells(122 + i * 3, 2).value = Controls("Text" & i + 1).value
                    Else
                    .Cells(120 + i * 3, 2).ClearContents
                    .Cells(122 + i * 3, 2).ClearContents
                    End If
                Next
            ElseIf mSinseiKbn = HYOJYUN Then
                For i = 0 To 9
                    If Controls("Text" & i + 1).value <> "" Then
                    .Cells(62 + i, 2).value = Dir(Controls("Text" & i + 1).value)
                    .Cells(62 + i, 4).value = Controls("Text" & i + 1).value
                    Else
                    .Cells(62 + i, 2).ClearContents
                    .Cells(62 + i, 4).ClearContents
                    End If
                Next
            End If
        End With
        
       Application.Calculation = xlAutomatic
        Set FSO = Nothing
End Sub
Private Sub ファイル開く(ByVal Box As String)

    Dim strFName As String
    Dim FSO As Object
    Dim flg As Boolean
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    strFName = Application.GetOpenFilename("(*.*),*.*")
    
    If strFName = "False" Then
        Exit Sub
    End If
    
    '拡張子検査
    Select Case mHokenKbn
        Case KB_HOKEN.SYAKAI
            If LCase(FileExtensionName(strFName)) <> "jpg" And LCase(FileExtensionName(strFName)) <> "pdf" Then
                MsgBox "指定したファイルの拡張子はJPG、または、PDFではありません。", vbInformation + vbOKOnly, Me.caption
                Exit Sub
            End If
        Case KB_HOKEN.KOYO
'            If LCase(FileExtensionName(strFName)) <> "pdf" And LCase(FileExtensionName(strFName)) <> "doc" Then
'                MsgBox "指定したファイルの拡張子はpdfまたはdocではありません。", vbInformation + vbOKOnly, Me.Caption
'                Exit Sub
'            End If
        Case KB_HOKEN.Roudo
            If LCase(FileExtensionName(strFName)) <> "pdf" Then
                MsgBox "指定したファイルの拡張子はpdfではありません。", vbInformation + vbOKOnly, Me.caption
                Exit Sub
            End If
        Case Else
            Exit Sub
    End Select
'#37486 hara 20170710「?」になってしまう文字チェック
    If isNotDisPlayChar(strFName) Then
        MsgBox "ファイル名に使用できない文字が含まれています。", vbCritical + vbOKOnly, Me.caption
        Exit Sub
    End If
    
    'ファイルの存在チェック
    If FSO.FileExists(strFName) <> True Then
        MsgBox "指定したファイルが見つかりません。" & vbCrLf & "参照先を確認してください。", vbOKOnly + vbCritical, "添付ファイルチェック"
        Exit Sub
    End If
    
    '別フォームとのファイルの同一チェック
    If GetmFileName <> "" Then
        flg = SameAttachFile(FSO.GetFile(strFName).name)
        If flg Then
            MsgBox "同じ名前のファイルは添付することができません。", vbOKOnly + vbCritical, "添付ファイルエラー"
            Controls("Text" & Box).value = ""
            Controls("Text" & Box).ControlTipText = ""
            Exit Sub
        End If
    End If
    
'#37486 ここまで
    Controls("Text" & Box).value = strFName
    Controls("Text" & Box).ControlTipText = strFName 'YBNO20196
    
    同名ファイルチェック Dir(Controls("Text" & Box).value), Box
    
    Controls("cmdPre" & Box).SetFocus 'YBNO20196
    
End Sub

Private Function SameAttachFile(ByVal fName As String) As Boolean
    SameAttachFile = False
    Dim attName() As String
    Dim s As Variant
    
    attName = Split(GetmFileName, ":")
    ReDim Preserve attName(UBound(attName) - 1)
    
    For Each s In attName()
        If fName = CStr(s) Then
            SameAttachFile = True
            Exit Function
        End If
    Next
End Function
Private Sub 同名ファイルチェック(ByVal fileName As String, ByVal no As String)

    Dim i As Long
    Dim MsgStr As String
    
    '初期化
    MsgStr = vbNullString
    
    For i = 1 To 10
        If i <> no Then '同じテキストボックスだったら何もしない
                
            ''' 20101021 YB 2313 型が一致しませんエラー
            If Controls("Text" & i).value <> "" Then
                If Dir(Controls("Text" & i).value) = fileName Then
                    MsgStr = "同じファイル名の添付ファイルが存在しているため指定できません。"
                    MsgStr = MsgStr & vbCrLf & "(" & i & "番目の添付ファイルと同じです。)" 'YBNO 20195
                    Exit For
                End If
            End If
            
            If Worksheets("DATA").Cells(3, 2).value <> "" And mHokenKbn = KB_HOKEN.SYAKAI Then
                If Dir(Worksheets("DATA").Cells(3, 2).value) = fileName Then
                    MsgStr = "JPG提出代行証明書と同じファイル名のため指定できません。"
                    Exit For
                End If
            End If
            
            ''' 20101021 YB 2313 型が一致しませんエラー
            If mwb.Worksheets("DATA").Cells(4, 2).value <> "" And (mHokenKbn = KB_HOKEN.KOYO Or mHokenKbn = KB_HOKEN.Roudo) Then
                If Dir(Worksheets("DATA").Cells(4, 2).value) = fileName Then
                    MsgStr = "PDF提出代行証明書と同じファイル名のため指定できません。"
                    Exit For
                End If
            End If
            
            If mwb.Worksheets("DATA").Cells(5, 2).value <> "" And mHokenKbn = KB_HOKEN.KOYO Then
                If Dir(Worksheets("DATA").Cells(5, 2).value) = fileName Then
                    MsgStr = "DOC提出代行証明書と同じファイル名のため指定できません。"
                    Exit For
                End If
            End If
                
        End If
    Next
                 
    If MsgStr <> vbNullString Then
        MsgBox MsgStr, vbInformation + vbOKOnly, Me.caption
        Controls("Text" & no).value = ""
        Controls("Text" & no).ControlTipText = "" 'YBNO20196
    End If
                 
End Sub

Attribute VB_Name = "CommonModule"
Option Explicit
Private mFilename As String  'ファイル名の文字列。区切り文字は「：」コロン
Private Declare Function SHCreateDirectoryEx Lib _
    "SHELL32" Alias "SHCreateDirectoryExA" ( _
    ByVal hwnd As Long, _
    ByVal pszPath As String, _
    ByVal psa As Long) As Long
Private Declare Function ShellExecute Lib _
    "SHELL32" Alias "ShellExecuteA" ( _
    ByVal hwnd&, _
    ByVal lpOperation$, _
    ByVal lpFile$, _
    ByVal lpParameters$, _
    ByVal lpDirectory$, _
    ByVal nShowCmd&) As Long
Private Const SW_NORMAL = 1
Private Type SYSTEMTIME
    wYear As Integer
    wMonth As Integer
    wDayOfWeek As Integer
    wDay As Integer
    wHour As Integer
    wMinute As Integer
    wSecond As Integer
    wMilliseconds As Integer
End Type
Private Declare Sub GetLocalTime Lib "kernel32" _
(lpSystemTime As SYSTEMTIME)

'セッタ― 20170718 hara
Public Sub SetmFilename(ByVal str As String)
    mFilename = str
End Sub

'ゲッター
Public Function GetmFileName() As String
    GetmFileName = mFilename
End Function
'hara ここまで

'''
' タイムスタンプ文字列を作る
'
'''
Public Function NowTimeString() As String
    
    Dim t As SYSTEMTIME
    
    GetLocalTime t
    NowTimeString = Format$(t.wHour, "00") & _
        Format$(t.wMinute, "00") & _
        Format$(t.wSecond, "00") & _
        Format$(t.wMilliseconds, "000")
    
End Function
'''
' IsExistFolder
' フォルダの有無を返す
' Flgを設定すると無い場合作る
'
'''
Public Function IsExistFolder(ByVal PathString As String) As Boolean

    Dim ret As Long

    ret = SHCreateDirectoryEx(0&, PathString, 0&)
    
    If ret = 0 Or ret = 80 Or ret = 183 Then
        IsExistFolder = True
    Else
        IsExistFolder = False
    End If

End Function
'''
' 関連付けられたアプリケーションでファイルを開く
'
'''
Public Function ShellExec(ByVal fileName As String) As Boolean

    Dim ret As Boolean

    ret = ShellExecute(0, "open", fileName, vbNullString, Environ("windir"), SW_NORMAL)

    ShellExec = ret > 32

End Function
'''
'
'パスの連結
'
'''
Public Function PathCombine(ByVal str1 As String, ByVal str2 As String) As String

    If VBA.Strings.Right(str1, 1) = "\" Then
        PathCombine = str1 & str2
    Else
        PathCombine = str1 & "\" & str2
    End If

End Function
'''
'
' ファイルの存在確認
'
'''
Public Function IsFileExist(ByVal fileName As String) As Boolean

    Dim FilePath As String
    Dim FSO As Object

    Set FSO = CreateObject("Scripting.FileSystemObject")

    IsFileExist = FSO.FileExists(fileName)
    
    Set FSO = Nothing

End Function
'''
'
' ファイルの拡張子を調べる
'
'''
Public Function FileExtensionName(ByVal fileName As String) As String

    Dim FSO As Object

    Set FSO = CreateObject("Scripting.FileSystemObject")

    FileExtensionName = FSO.GetExtensionName(fileName)
    
    Set FSO = Nothing

End Function
'''
'
' UNCパスかどうか調べる
'
'''
Public Function IsUNC(ByVal PathName As String) As Boolean

    Dim ret As Boolean

    ret = False

    If Left(PathName, 2) = "\\" Or Left(PathName, 7) = "file://" Then
        ret = True
    End If

    IsUNC = ret

End Function
'''
'
' フォルダをコピーする
'
'''
Public Sub FolderCopy(ByVal FromFolder As String, ByVal ToFolder As String)
    
    Dim FSO As Object

    Set FSO = CreateObject("Scripting.FileSystemObject")

    FSO.CopyFolder FromFolder, ToFolder
    
    Set FSO = Nothing

End Sub
'''
'
' フォルダを削除する
'
'''
Public Sub FolderDelete(ByVal FolderName As String)

    Dim FSO As Object

    Set FSO = CreateObject("Scripting.FileSystemObject")

    FSO.DeleteFolder FolderName
    
    Set FSO = Nothing

End Sub
'''
'
' テキストデータを読み出す
'
'''
Public Function GetTextData(ByVal i As Integer, ByVal fileName As String) As String
  
    Dim buffer() As String '文字列受け取り用
    
    GetStringArray buffer, fileName

    GetTextData = buffer(i - 1)

End Function
Private Sub GetStringArray(ByRef str() As String, ByVal fileName As String)

    Dim FileNumber As Integer 'ファイル番号
    Dim LineCount As Integer '行数

    '初期処理
    FileNumber = FreeFile
    LineCount = 0

    'DOTO FreeFileで番号を得ること
    Open fileName For Input As FileNumber

        Do While Not EOF(FileNumber)
            'ファイルの長さで配列をデータを保持しながら初期化
            ReDim Preserve str(LineCount)
    
            'ファイルをバイナリで読み込んで配列に格納
            Line Input #FileNumber, str(LineCount)
            LineCount = LineCount + 1
        Loop
           
    Close #FileNumber

End Sub
'''
''' ファイルのバージョンを調べる
'''
Public Function GetFileVersion(ByVal fName As String)

    Dim objFso As Object
    
    Set objFso = CreateObject("Scripting.FileSystemObject")
    
    If objFso.FileExists(fName) Then
        GetFileVersion = objFso.GetFileVersion(fName)
    Else
        GetFileVersion = vbNullString
    End If
        
    Set objFso = Nothing

End Function
'''
''' Excelファイルが開いているかどうか返す
'''
Public Function IsOpenExcelFile(ByVal BookName As String) As Boolean

    Dim wb As Workbook
    Dim ret As Boolean

    ret = False

    For Each wb In Workbooks
        If wb.name = BookName Then
            ret = True
            Exit For
        End If
    Next

    IsOpenExcelFile = ret

End Function
'''
''' 文字コード
'''
''' http://www.atmarkit.co.jp/bbs/phpBB/viewtopic.php?topic=9227&forum=7
Public Function CharCheck(ByVal str As String) As String
   
    Dim strReturn As String
    Dim intStrLen As Integer
    Dim intChar As Integer
    Dim i As Integer

    intStrLen = Len(str)
    
    strReturn = ""
    
    For i = 1 To intStrLen
        intChar = Asc(mId(str, i, 1))
        If (intChar <= -30823 And intChar >= -30912) _
            Or (intChar <= -949 And intChar >= -1472) _
            Or intChar = -32322 Or intChar = -32321 _
            Or intChar = -32282 Then
            strReturn = strReturn & Chr(intChar)
        End If
    Next i

    If strReturn <> "" Then
        CharCheck = strReturn
    Else
        CharCheck = vbNullString
    End If
End Function

'20170710 hara API対応(添付ファイル正規化)のため新規追加関数 #37505
'添付ファイル名の変更前と変更後のファイル名を紐づける関数
'Range      ・・・添付ファイルのフルパス。最大10件
'daikopath  ・・・提出代行パス
'paths      ・・・申請毎に異なる添付ファイルのフルパス(ローマ字や総括表、附表)
'dic 対応表
Public Sub AssociatedFiles(tempRange As Object, daikopath As String, paths() As String, ByRef dic As Object)
    Dim FSO As Object
    Dim ext As String       '拡張子を入れる文字
    Dim i As Long           '添付ファイルの添え字
    Dim fileName As String
    Dim targetCell As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")
    i = 1
    
    '提出代行と添付ファイル1～10の紐づけ
    For Each targetCell In tempRange
        '提出代行証明書と添付ファイル1～10のファイル名を紐づけ
        If Trim(targetCell.value) <> "" Then
            '提出代行証明書
            If targetCell.Offset(0, -1).value Like "*提出代行*" Then
                ext = FSO.GetExtensionName(daikopath)
                '#39754 hara 20171226
                If Not targetCell.value = "teisyutudaiko" & "." & ext Then
                    dic.Add targetCell.value, "teisyutudaiko" & "." & ext
                    targetCell.value = "teisyutudaiko" & "." & ext
                Else
                    dic.Add targetCell.value, "teisyutudaikohk" & "." & ext
                    targetCell.value = "teisyutudaikohk" & "." & ext
                End If
            '標準形式
            ElseIf targetCell.Offset(0, -1).value Like "その他添付書類*" Then
                ext = FSO.GetExtensionName(targetCell.Offset(0, 2).value)
                dic.Add targetCell.value, "attachFile_" & i & "." & ext
                targetCell.value = "attachFile_" & i & "." & ext
                i = i + 1
            '個別形式
            ElseIf targetCell.Offset(0, -1).value Like "添付ファイル*" Then
                ext = FSO.GetExtensionName(targetCell.Offset(2, 0).value)
                dic.Add targetCell.value, "attachFile_" & i & "." & ext
                targetCell.value = "attachFile_" & i & "." & ext
                i = i + 1
            '本人同意書(扶養届で使用)
            ElseIf targetCell.Offset(0, -1).value Like "本人同意書*" Then
                ext = FSO.GetExtensionName(targetCell.Offset(2, 0).value)
                dic.Add targetCell.value, "trust_" & i & "." & ext
                targetCell.value = "trust_" & i & "." & ext
                i = i + 1
            Else
                '該当処理なし
            End If
        End If
    Next
    
    '申請によって異なるファイルの紐づけ
    For i = 0 To UBound(paths)
        If paths(i) <> "" And FSO.FileExists(paths(i)) Then
            fileName = FSO.GetFileName(paths(i))
            ext = FSO.GetExtensionName(paths(i))
            dic.Add fileName, "attachFile_" & i + 11 & "." & ext
        End If
    Next
    Set FSO = Nothing

End Sub

'20170710 hara API対応(添付ファイル正規化)のため新規追加関数 #37505
'電子申請データの添付ファイルをリネームする処理
Public Sub FileRename(dic As Object, dataPath As String)
    Dim arr() As String
    Dim FSO As Object, f As Object
    Dim i As Long
    Dim testName As Variant
    Set FSO = CreateObject("Scripting.FileSystemObject")

    '添付ファイルがない場合は処理を抜ける
    If dic.count <= 0 Then
        Exit Sub
    End If
    
    'フォルダ内のファイル名を配列に格納する
    ReDim arr(0)
    For Each testName In FSO.GetFolder(dataPath).Files  '申請フォルダから一つずつファイルを取得して添付ファイルかチェック
        arr(UBound(arr)) = testName.name
        i = i + 1
        ReDim Preserve arr(UBound(arr) + 1)
'        If Not testName Like "*.xsl" And Not testName Like "*.xml" And Not testName Like "*.csv" Then
''        If testName Like "*[!.xsl,.xml,.csv]" Then      'xsl,xml,csvは申請ファイルなので添付ファイルではない
'            testName.name = dic(CStr(testName.name))
'        End If
    Next
    ReDim Preserve arr(UBound(arr) - 1)
    '該当のファイル名を変更する
    For Each testName In arr
        If Not testName Like "*.xsl" And Not testName Like "*.xml" And Not testName Like "*.csv" Then
            Set f = FSO.GetFile(dataPath & "\" & testName)
            f.name = dic(CStr(testName))
        End If
    Next
    
    Set FSO = Nothing
    Set f = Nothing
End Sub

'20170710 hara API対応(添付ファイル正規化)のため新規追加関数 #37505
'XMLの添付ファイル変更後のデータを変更前のファイル名に戻す
Public Sub FileUndo(fileRange As Object, isKobetu As Boolean)
    Dim Target As Object
    Dim FSO As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Dim fileName As String
    
    For Each Target In fileRange
        If Target.value <> "" Then
            If isKobetu Then
                If Target.Offset(2, 0).value <> "" And FSO.FileExists(Target.Offset(2, 0).value) Then
                    fileName = FSO.GetFileName(Target.Offset(2, 0).value)
                    Target.value = fileName
                End If
            Else
                If Target.Offset(0, 2).value <> "" And FSO.FileExists(Target.Offset(0, 2).value) Then
                    fileName = FSO.GetFileName(Target.Offset(0, 2).value)
                    Target.value = fileName
                End If
            End If
        Else
            If isKobetu Then
                Target.Offset(2, 0).value = ""  '添付ファイルのフルパスを削除
                Target.Offset(1, 0).value = ""  '添付ファイルの構成情報を削除
                Target.value = ""                   '添付ファイル名を削除
            End If
        End If
    Next
    
    Set FSO = Nothing
End Sub

'file1・・・ファイル１のパス
'file2・・・ファイル２のパス
Public Function IsSameFile(file1 As String, file2 As String) As Boolean
    IsSameFile = False
    
    'どちらかが空欄であれば一致することはない
    If file1 = "" Or file2 = "" Then
        Exit Function
    End If
    
    With CreateObject("Scripting.FileSystemObject")
        If .FileExists(file1) And .FileExists(file2) Then
            'ファイルが存在していれば、パスからファイル名を取得
            If .GetFile(file1).name = .GetFile(file2).name Then
                IsSameFile = True
            End If
        End If
    End With
End Function

Public Function IsDaikoExist(daikoRange As Range) As Boolean
    Dim r As Range   'foreachの変数
    IsDaikoExist = False
    
    For Each r In daikoRange
        If Trim(r.value) <> "" Then
            IsDaikoExist = True '提出代行が設定してあればTrueに設定する
        End If
    Next
End Function

'#37486 hara 20170710 API対応
'VBAで表示できない関数を検出する関数
Public Function isNotDisPlayChar(ByVal path As String) As Boolean
    Dim l As Long
    Dim i As Long
    Dim h1 As Long
    Dim h2 As Long
    Dim fileName As String
    Dim FSO As Object
    Dim s As String
    Set FSO = CreateObject("Scripting.FileSystemObject")
    fileName = FSO.GetFileName(path)
    isNotDisPlayChar = False
    l = Len(fileName)
    
    For i = 1 To l
        s = mId(fileName, i, 1)
        h1 = Asc(s)
        If h1 = 63 Then
            h2 = AscW(s)
            If h1 <> h2 Then
                isNotDisPlayChar = True
                Exit Function
            End If
        End If
    Next
    
    Set FSO = Nothing
End Function

'電子申請データ作成時にエラーが出る可能性のある文字を検出する関数
' isNotDisPlayCharの引数がファイル名になっただけです。isNotDisPlayCharはフルパスを引数にとる。賞与の総括表を作成するときに呼び出しています。
'いつかこの関数に統合します。 by hara
Public Function isNotFileNameChar(ByVal fileName As String) As Boolean
    Dim l As Long
    Dim i As Long
    Dim h1 As Long
    Dim h2 As Long
    Dim s As String
    isNotFileNameChar = False
    l = Len(fileName)
    
    For i = 1 To l
        s = mId(fileName, i, 1)
        h1 = Asc(s)
        If h1 = 63 Then
            h2 = AscW(s)
            If h1 <> h2 Then
                isNotFileNameChar = True
                Exit Function
            End If
        End If
    Next
End Function
'#37486 ここまで
'20170710 hara API対応(添付ファイル正規化)のため新規追加関数 #37505 ここまで
Public Function IsExist(ByVal str As String, Optional ByVal FolderFlg As Boolean = True) As Boolean

    Dim FSO As Object
    Dim ret As Boolean
    
    ret = False
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    If FolderFlg Then
        ret = FSO.FolderExists(str)
    Else
        ret = FSO.FileExists(str)
    End If
    
    Set FSO = Nothing
    
    IsExist = ret
    
End Function
Public Sub AllSelectedListBox(ByRef lb As MSForms.ListBox, Optional ByVal flg As Boolean = True)
    Dim iCount As Integer
    
    For iCount = 0 To lb.ListCount - 1
        lb.Selected(iCount) = flg
    Next
    
End Sub
Public Sub DispXMLData(ByVal str As String)

    'Call Shell("C:\Program Files\Internet Explorer\iexplore.exe " & str, vbNormalFocus)

    'MsgBox Environ("ProgramFiles")

    Shell Environ("ProgramFiles") & "\Internet Explorer\iexplore.exe " & str, vbNormalFocus

End Sub

Attribute VB_Name = "ApplyModule"
Option Explicit
Public Enum KB_HOKEN
    SYAKAI = 1
    KOYO = 2
    Roudo = 3
End Enum
Public Enum KEISIKI_SINSEI
    HYOJYUN = 1
    KOBETU = 2
End Enum
'ShellExecuteEXで使用する構造体
Private Type SHELLEXECUTEINFO
    cbSize As Long
    fMask As Long
    hwnd As Long
    lpVerb As String
    lpFile As String
    lpParameters As String
    lpDirectory As String
    nShow As Long
    hInstApp As Long
    lpIDList As Long
    lpClass As String
    hkeyClass As Long
    dwHotKey As Long
    hIcon As Long
    hProcess As Long
End Type
'WaitForSingleObject
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function ShellExecuteEX Lib "shell32.dll" Alias "ShellExecuteEx" (SEI As SHELLEXECUTEINFO) As Long
'WaitForSingleObjectで使用する定数
Private Const INFINITE = &HFFFF ' Infinite timeout
'ShellExecuteEXで使用する定数
Private Const SEE_MASK_NOCLOSEPROCESS = &H40
Private Const SW_SHOWNORMAL = 1

Private Const EGOV_DLL_PATH As String = "cells\台帳電子申請ツール\egov.dll"
Private Const NEW_DLL_VER As String = "2.14.0.0"

'#39369 年金事務所名前コード変換
'平成28年10月
Private Const PENSION_OFFICE_NAME_NAKANO As String = "東京,中野年金事務所（東京事務センター）"
Private Const PENSION_OFFICE_NAME_SUGINAMI As String = "東京,杉並年金事務所（東京事務センター）"
Private Const PENSION_OFFICE_NAME_SINJYUKU As String = "東京,新宿年金事務所（東京事務センター）"
Private Const PENSION_OFFICE_NAME_NANBA As String = "大阪,難波年金事務所（大阪事務センター）"
Private Const PENSION_OFFICE_NAME_IMASATO As String = "大阪,今里年金事務所（大阪事務センター）"
Private Const PENSION_OFFICE_NAME_JYOTO As String = "大阪,城東年金事務所（大阪事務センター）"
Private Const PENSION_OFFICE_NAME_OOTEMAE As String = "大阪,大手前年金事務所（大阪事務センター）"

Private Const PENSION_OFFICE_CODE_NAKANO As String = "49511200070000000000149"
Private Const PENSION_OFFICE_CODE_SUGINAMI As String = "49511200070000000000137"
Private Const PENSION_OFFICE_CODE_SINJYUKU As String = "49511200070000000000136"
Private Const PENSION_OFFICE_CODE_NANBA As String = "49511200070000000000248"
Private Const PENSION_OFFICE_CODE_IMASATO As String = "49511200070000000000244"
Private Const PENSION_OFFICE_CODE_JYOTO As String = "49511200070000000000246"
Private Const PENSION_OFFICE_CODE_OOTEMAE As String = "49511200070000000000239"

'平成29年2月
Private Const PENSION_OFFICE_NAME_NAGOYAKITA As String = "愛知,名古屋北年金事務所（愛知事務センター）"
Private Const PENSION_OFFICE_NAME_OZONE As String = "愛知,大曽根年金事務所（愛知事務センター）"
Private Const PENSION_OFFICE_NAME_HIROSHIMANISHI As String = "広島,広島西年金事務所（広島事務センター）"
Private Const PENSION_OFFICE_NAME_HIROSHIMAMINAMI As String = "広島,広島南年金事務所（広島事務センター）"
Private Const PENSION_OFFICE_NAME_HIROSHIMAHIGASHI As String = "広島,広島東年金事務所（広島事務センター）"

Private Const PENSION_OFFICE_CODE_NAGOYAKITA As String = "49511200070000000000215"
Private Const PENSION_OFFICE_CODE_OZONE As String = "49511200070000000000209"
Private Const PENSION_OFFICE_CODE_HIROSHIMANISHI As String = "49511200070000000000289"
Private Const PENSION_OFFICE_CODE_HIROSHIMAMINAMI As String = "49511200070000000000294"
Private Const PENSION_OFFICE_CODE_HIROSHIMAHIGASHI As String = "49511200070000000000288"

'平成29年11月
…