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{75A9C862-6436-4744-80C9-93BAC64044FC}{42C03312-DB03-460A-8984-C218E49F59C5}"
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
        
        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

End Sub
Private Sub ファイル開く(ByVal Box As String)

    Dim strFName As String

    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
    
    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 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 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)
'''
' タイムスタンプ文字列を作る
'
'''
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


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.13.0.2"

'''
''' 添付ファイル設定画面を表示する
'''
Public Function DisplayAttach(ByVal HokenKbn As KB_HOKEN, ByVal skb As KEISIKI_SINSEI, ByRef wb As Workbook, _
        Optional ByVal needLog As Boolean = False, _
        Optional ByVal ProcName As String = vbNullString, _
        Optional ByVal guid As String = vbNullString, _
        Optional ByVal Name As String = vbNullString _
        ) As Variant()

    Dim frm As New 添付

    frm.HokenKbn = HokenKbn
    frm.SinseiKbn = skb
    Set frm.mwb = wb

    frm.needLog = needLog
    frm.ProcName = ProcName
    frm.guid = guid
    
    Dim ComAccount As String
    ComAccount = Application.Run("業務日誌.xlam!GetCompanyData", Workbooks(wb.Worksheets("DATA").Cells(1, 1).Value))
    frm.CompanyAccount = ComAccount
    
    frm.TargetName = Name
    
    frm.Show

End Function
'''
''' 指定した添付ファイルをプレビューする
'''
Public Function DispayAttachFile(ByVal FileName As String) As Boolean
   
    Dim ret As Boolean
   
    'ファイルがあるか？
    ret = IsFileExist(FileName)
    
    If ret Then
        'ファイルを開く
        ShellExec FileName
    End If
    
    DispayAttachFile = ret

End Function
'''
''' 添付ファイルデータのクリア
'''
Public Sub ClearAttachFile(ByRef ws As Worksheet)

    Dim Num As Long
    
    Num = 10 '添付ファイル画面の数

    ws.Range(ws.Cells(120, 2), ws.Cells(120 + 3 * (Num - 1) + 2, 2)).ClearContents

End Sub
'''
''' 会社情報のファイルがあるかどうか返す
'''
Public Function IsCompanyInfoFileExist(ByVal CompanyName As String) As String

    Dim FilePath As String

    FilePath = PathCombine(Workbooks("DaMenu.xls").path, "DaProcess\MyTool\提出代行")
    FilePath = PathCombine(FilePath, CompanyName & ".txt")
    
    If IsFileExist(FilePath) Then
        IsCompanyInfoFileExist = FilePath
    Else
        IsCompanyInfoFileExist = vbNullString
    End If

End Function
'''
''' 申請者情報のファイルがあるかどうか返す
'''
Public Function IsApplicantInfoFileExist(ByVal DaFileName As String) As String

    Dim lAppInfoNo As Long
    Dim FilePath As String
    
    lAppInfoNo = Workbooks(DaFileName).Worksheets("会社情報").Cells(86, 2).Value
    
    If lAppInfoNo = 0 Then lAppInfoNo = 1
    
    FilePath = PathCombine(Workbooks("DaMenu.xls").path, "DaProcess\Da保存\電子申請申請者\申請者情報" & lAppInfoNo & ".txt")

    If IsFileExist(FilePath) Then
        IsApplicantInfoFileExist = FilePath
    Else
        IsApplicantInfoFileExist = vbNullString
    End If

End Function
'''
''' 提出先コードがあるかどうか返す
'''
Public Function SubmittedCodeCheck(ByRef wb As Workbook, ByVal target As String) As String

    Dim i As Long
    Dim ret As String

    Application.Calculation = xlCalculationManual
    
    Workbooks.Open PathCombine(wb.path, "提出先一覧.xls")
    
    For i = 1 To Cells(1005, 7).End(xlUp).Row
        If target = Cells(i, 7).Value Then
            ret = Cells(i, 6).Value
            Exit For
        End If
    Next
    
    Workbooks("提出先一覧.xls").Close False
    
    Application.Calculation = xlCalculationAutomatic

    SubmittedCodeCheck = ret

End Function
'''
''' CSV形式のマスター画面の入力項目をチェックする
'''
Public Function CSVMasterCheck(ByRef frm As MSForms.UserForm) As Boolean

    Dim ret As Boolean
    
    ret = False

    With frm

         '作成年月日
        If .Text1.Text = vbNullString Then
            MsgBox "作成年月日が不正です。", vbInformation + vbOKOnly, .caption
            CSVMasterCheck = ret
            Exit Function
        End If
        
        'FD通番
        If frm.Text2.Text = vbNullString Then
            MsgBox "FD通番が未入力です。", vbInformation + vbOKOnly, .caption
            CSVMasterCheck = ret
            Exit Function
        ElseIf Not IsNumeric(.Text2.Text) Then
            MsgBox "FD通番が不正です。", vbInformation + vbOKOnly, .caption
            CSVMasterCheck = ret
            Exit Function
        ElseIf CLng(.Text2.Text) < 1 Or CLng(.Text2.Text) > 999 Then
            MsgBox "FD通番は、1以上999以下です。", vbInformation + vbOKOnly, .caption
            CSVMasterCheck = ret
            Exit Function
        End If
        
        '提出先 TextBox1
        '提出先コード TextBox6
        If .TextBox1.Text = vbNullString Or .TextBox6 = vbNullString Then
            MsgBox "提出先または提出先コードが未設定です。", vbInformation + vbOKOnly, .caption
            CSVMasterCheck = ret
            Exit Function
        End If
        
        '会社データ TextBox2
        If .TextBox2.Text = vbNullString Then
            MsgBox "会社データが未設定です。", vbInformation + vbOKOnly, .caption
            CSVMasterCheck = ret
            Exit Function
        End If
    
        '申請者 TextBox3
        If .TextBox3.Text = vbNullString Then
            MsgBox "申請者が未設定です。", vbInformation + vbOKOnly, .caption
            CSVMasterCheck = ret
            Exit Function
        End If
    
        '社労士コード
        If .TextBox4.Text = vbNullString And Not .CheckBox1.Value Then
            MsgBox "社労士コードが未設定です。", vbInformation + vbOKOnly, .caption
            CSVMasterCheck = ret
            Exit Function
        End If
        
        '提出代行
        If .TextBox5.Text = vbNullString And Not .CheckBox1.Value Then
            MsgBox "提出代行が未設定です。", vbInformation + vbOKOnly, .caption
            CSVMasterCheck = ret
            Exit Function
        ElseIf Not IsFileExist(.TextBox5.Text) And Not .CheckBox1.Value Then
            MsgBox "提出代行ファイルが見つかりません。", vbInformation + vbOKOnly, .caption
            CSVMasterCheck = ret
            Exit Function
        End If
    
    End With

    ret = True
    
    CSVMasterCheck = ret

End Function
'''
''' 社会保険仕様チェックプログラムを起動する
'''
Public Sub SICheckProc(ByVal CSVFolder As String, ByVal flg As Boolean, ByRef wb As Workbook)
    
    Dim TempFolder As String

    TempFolder = PathCombine(Environ("TEMP"), "Cells")

    '必要なフォルダを用意する
    IsExistFolder TempFolder

    FolderCopy Trim(CSVFolder), TempFolder & "\"
    
    CheckProguramProc Trim(PathCombine(TempFolder, wb.Worksheets("DATA").Cells(26, 2).Value)), flg, wb.Worksheets("DATA").Cells(2, 2).Value
    
    CopyText Trim(PathCombine(TempFolder, wb.Worksheets("DATA").Cells(26, 2).Value))
    
End Sub
'''
''' CSVファイルを作る
'''
Public Function CreateCSVFile(ByRef wb As Workbook) As String

    Dim SHFDFolder As String
    
    SHFDFolder = Trim(PathCombine(PathCombine(wb.path, "SHFD0006"), wb.Worksheets("DATA").Cells(26, 2).Value))
    IsExistFolder SHFDFolder
    
    SHFD0006作成 PathCombine(SHFDFolder, "SHFD0006.csv"), wb
    
    wb.Worksheets("社ＣＳＶ").Select
    wb.Worksheets("DATA").Cells(15, 2).Value = "作成済"
    
    CreateCSVFile = SHFDFolder

End Function
'''
''' CSVファイルを消す
'''
Public Sub DeleteCSVFile(ByRef wb As Workbook)

    Dim SHFDFolder As String
    
    SHFDFolder = Trim(PathCombine(PathCombine(wb.path, "SHFD0006"), wb.Worksheets("DATA").Cells(26, 2).Value))
    IsExistFolder SHFDFolder
    
    If IsFileExist(PathCombine(SHFDFolder, "SHFD0006.csv")) Then
        Kill PathCombine(SHFDFolder, "SHFD0006.csv")
    End If
    
    Dim TempFolder As String

    TempFolder = Trim(PathCombine(PathCombine(Environ("TEMP"), "Cells"), wb.Worksheets("DATA").Cells(26, 2).Value))
    
    If IsExistFolder(TempFolder) Then
        FolderDelete TempFolder
    End If
    
    CopyText vbNullString
    
End Sub
'''
''' CSVを作る
'''
Private Sub SHFD0006作成(ByVal FileName As String, ByRef wb As Workbook)

    Dim MyBuf() As String
    Dim Ro As Long
    Dim k As Long
    Dim EndR As Long
    Dim C As Range
    Dim Fnum As Integer
    Dim n As Long
        
    If FileName = vbNullString Then Exit Sub
    
    'wb.Sheets("SHFD0006").Select
    
    EndR = wb.Sheets("SHFD0006").Cells(65536, 1).End(xlUp).Row

    n = 1
    For Ro = 1 To EndR
        ReDim Preserve MyBuf(n)
        
        For Each C In Range(wb.Sheets("SHFD0006").Cells(Ro, 1), wb.Sheets("SHFD0006").Cells(Ro, 256).End(xlToLeft))
            If C.Column = 1 Then
                MyBuf(n) = C.Value
            ElseIf C.Value = "Q" Then
            Else
                If n = 3 Then
                    '事業所数は強制的に1件とする
                    MyBuf(n) = MyBuf(n) & "," & "001"
                Else
                    MyBuf(n) = MyBuf(n) & "," & C.Value
                End If
            End If
        Next C
        n = n + 1
    Next Ro

    If n <= 6 Then
    Else
        Fnum = FreeFile()
        Open FileName For Output As #Fnum
            For k = LBound(MyBuf) To UBound(MyBuf)
                If k = 0 Then
                Else
                    Print #Fnum, MyBuf(k)
                End If
            Next k
        Close #Fnum

    End If

    Erase MyBuf

End Sub
'''
''' 一括申請ツールをインストールが必要か返す
'''
Public Function IsInstallEgovDll() As Boolean
 
    If NEW_DLL_VER > GetEGovDLLFileVersion Then
        IsInstallEgovDll = True
    Else
        IsInstallEgovDll = False
    End If

End Function
'''
''' 一括申請ツールをインストールする
'''
Public Sub InstallEgovDll()

    InstallProc PathCombine(Workbooks("damenu.xls").path, "setup.exe")
    If IsOpenExcelFile("電子申請.xls") Then
        Workbooks("電子申請.xls").Close False
    End If

End Sub
Public Function GetEGovDLLFileVersion() As String

    Dim EgovDllPath As String

    EgovDllPath = PathCombine(VBA.Interaction.Environ("ProgramFiles"), EGOV_DLL_PATH)
    
    GetEGovDLLFileVersion = GetFileVersion(EgovDllPath)

End Function
Private Function InstallProc(ByVal strFilePath As String) As Long

    Dim ret     As Long
    Dim sdtSEXI As SHELLEXECUTEINFO

    With sdtSEXI
        .cbSize = Len(sdtSEXI)
        .fMask = SEE_MASK_NOCLOSEPROCESS
…