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
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    
    ThisWorkbook.Saved = True
    
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    
    MsgBox "このファイルは保存できません。", 16, "保存不可"
    Cancel = True
    
End Sub



Attribute VB_Name = "Sheet6"
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 = "Sheet5"
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 = "Sheet18"
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 = "Sheet2"
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

Attribute VB_Name = "Function1"
Option Explicit

Public Const AAA As String = "異動届"


'本当のバイト数
Function LenMbcs(ByVal str As String)
    LenMbcs = LenB(StrConv(str, vbFromUnicode))
End Function
'半角カナの数
Function 半角カナ(strg As String)

    Dim i As Integer
    Dim strg1 As String
    Dim n As Integer
    
    n = 0
    For i = 1 To Len(strg)
    strg1 = Mid(strg, i, 1)
    If Asc(strg1) <= 223 And Asc(strg1) >= 166 Then
    n = n + 1
    End If
    Next
    半角カナ = n
    
End Function
'半角数値の数(「-」含む）
Function 半角数値(strg As String)
 Dim i As Integer
 Dim strg1 As String
 Dim n As Integer
n = 0
For i = 1 To Len(strg)
strg1 = Mid(strg, i, 1)
If Asc(strg1) <= 57 And Asc(strg1) >= 48 Or Asc(strg1) = 45 Then
n = n + 1
End If
Next
半角数値 = n
End Function
'半角文字の数
Function 半角文字(strg As String)
 Dim i As Integer
 Dim strg1 As String
 Dim n As Integer
n = 0
For i = 1 To Len(strg)
strg1 = Mid(strg, i, 1)
If Asc(strg1) < 256 And Asc(strg1) >= 0 Then
n = n + 1
End If
Next
半角文字 = n
End Function
Function 無効文字(strg As String)
 Dim i As Integer
 Dim strg1 As String
 Dim n As Integer
n = 0
For i = 1 To Len(strg)
strg1 = Mid(strg, i, 1)
If Asc(strg1) < 0 Then
If Asc(strg1) > -5468 Then
n = n + 1
End If
End If
Next
無効文字 = n
End Function
Function スペース(strg As String)
 Dim i As Integer
 Dim strg1 As String
 Dim n As Integer
n = 0
For i = 1 To Len(strg)
strg1 = Mid(strg, i, 1)
If strg1 = " " Or strg1 = "　" Then
n = n + 1
End If
Next
スペース = n
End Function
Function 半角スペース(strg As String)
 Dim i As Integer
 Dim strg1 As String
 Dim n As Integer
n = 0
For i = 1 To Len(strg)
strg1 = Mid(strg, i, 1)
If strg1 = " " Then
n = n + 1
End If
Next
半角スペース = n
End Function
Function 文字判定(strUnicode As String)
          Dim strANSI As String
          Dim lchar As Integer, lbyte As Integer
          strANSI = StrConv(strUnicode, vbFromUnicode)
          lchar = Len(strUnicode)
          lbyte = LenB(strANSI)
          If lchar * 2 = lbyte Then
              文字判定 = 1 '全角文字のみ
          ElseIf lchar = lbyte Then
              文字判定 = 2 '半角文字のみ
          Else
              文字判定 = 3 '混在
          End If
End Function

Function Mydate(セル As Variant)
If セル = "" Then
 Mydate = ""
 Else
 If セル >= 32516 Then
 Mydate = 7
 ElseIf セル >= 9856 Then
 Mydate = 5
 ElseIf セル >= 4595 Then
 Mydate = 3
 Else
 Mydate = 1
 End If
Mydate = Mydate & "-" & Format(セル, "ee") & Format(セル, "mm") & Format(セル, "dd")
End If
End Function
Function Mydate2(text As Variant)
If text = "" Then
 Mydate2 = ""
 Else
 If Mid(text, 1, 1) = 7 Then
 Mydate2 = 1988
 ElseIf Mid(text, 1, 1) = 5 Then
 Mydate2 = 1925
 ElseIf Mid(text, 1, 1) = 3 Then
 Mydate2 = 1911
 Else
 Mydate2 = 1867
 End If
 ''' 7桁用に改造した
Mydate2 = DateSerial(Mid(text, 2, 2) + Mydate2, Mid(text, 4, 2), Mid(text, 6, 2))
End If
End Function
Function 社TEL(Denwa As String)
            Dim j As Integer
            Dim k As Integer
            Dim l As Integer
            j = 0
            k = 0
            With Worksheets("社総括票")
                For l = 1 To Len(Denwa)
                    If Mid(Denwa, l, 1) = "-" Then
                        If j = 0 Then
                            j = l
                            Else
                            k = l
                        End If
                    End If
                Next
                If j = 0 Then 'ＴＥＬ１
'                    .Cells(37, 2).Value = Denwa
                    .Cells(38, 2).Value = Denwa
                    Exit Function
                    Else
                  '  .Cells(37, 2).Value = Mid(Denwa, 1, j - 1)
                    .Cells(38, 2).Value = Mid(Denwa, 1, j - 1)
                End If
                If k = 0 Then 'ＴＥＬ2
                  '  .Cells(38, 2).Value = Mid(Denwa, j + 1, Len(Denwa) - j)
                    .Cells(39, 2).Value = Mid(Denwa, j + 1, Len(Denwa) - j)
                    Exit Function
                    Else
                  '   .Cells(38, 2).Value = Mid(Denwa, j + 1, k - j - 1)
                   .Cells(39, 2).Value = Mid(Denwa, j + 1, k - j - 1)
                End If
               ' .Cells(39, 2).Value = Mid(Denwa, k + 1, Len(Denwa) - k) 'ＴＥＬ3
                .Cells(40, 2).Value = Mid(Denwa, k + 1, Len(Denwa) - k) 'ＴＥＬ3
            End With
End Function
Function 雇TEL(Denwa As String, Cell As Integer)
            Dim j As Integer
            Dim k As Integer
            Dim l As Integer
            j = 0
            k = 0
            With Worksheets("雇総括票")
                For l = 1 To Len(Denwa)
                    If Mid(Denwa, l, 1) = "-" Then
                        If j = 0 Then
                            j = l
                            Else
                            k = l
                        End If
                    End If
                Next
                If j = 0 Then 'ＴＥＬ１
                    .Cells(Cell, 2).Value = Denwa
                    Exit Function
                    Else
                    .Cells(Cell, 2).Value = Mid(Denwa, 1, j - 1)
                End If
                If k = 0 Then 'ＴＥＬ2
                    .Cells(Cell + 1, 2).Value = Mid(Denwa, j + 1, Len(Denwa) - j)
                    Exit Function
                    Else
                    .Cells(Cell + 1, 2).Value = Mid(Denwa, j + 1, k - j - 1)
                End If
                .Cells(Cell + 2, 2).Value = Mid(Denwa, k + 1, Len(Denwa) - k) 'ＴＥＬ3
            End With
End Function
Public Function カンマ削除(tData) As String
    Dim rData   As String
    Dim iCnt    As Integer
    
    For iCnt = 1 To Len(tData)
        If Asc(Mid(tData, iCnt, 1)) = 13 Or Asc(Mid(tData, iCnt, 1)) = 10 Or Asc(Mid(tData, iCnt, 1)) = 44 Then
            rData = rData & " "
        Else
            rData = rData & Mid(tData, iCnt, 1)
        End If

    Next iCnt

    カンマ削除 = rData

End Function
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
Public Sub SetTextData(ByVal i As Integer, ByVal str As String, ByVal FileName As String)

    '先に全部読み込む

    Dim buffer() As String '文字列受け取り用
    
    GetStringArray buffer, FileName
    
    '書き換えたい文字列
    buffer(i - 1) = str
    
    Dim FileNumber As Integer 'ファイル番号
    Dim LineCount As Integer '行数

    '初期処理
    FileNumber = FreeFile
    LineCount = 0

    'DOTO FreeFileで番号を得ること
    Open FileName For Output As #FileNumber

    For LineCount = 0 To UBound(buffer)
            'ファイルをバイナリで読み込んで配列に格納
            Print #FileNumber, buffer(LineCount)
    Next
           
    Close #FileNumber
    
End Sub
Public 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 PathCombine(ByVal str1 As String, ByVal str2 As String) As String

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

End Function

Function FileNameCheck(name As String) As Boolean
    
    '空欄だったら何もしない
    FileNameCheck = True
    If name = "" Then Exit Function
    
    'ファイル名を取得
    Dim FSO, PathName As String, FileName As String
    Set FSO = CreateObject("Scripting.FileSystemObject")
    FileName = FSO.GetFileName(name)
    
    '取得したファイル名をCheckHankakuで１文字ずつチェック
    If CheckHankaku(Left(FileName, Len(FileName) - 4)) = False Then
        FileNameCheck = False
        Exit Function
    End If
    
    Set FSO = Nothing
    FileNameCheck = True
    
End Function
Function CheckHankaku(strChkData As String) As Boolean

    Dim strHan As String, i As Integer

    '変数に半角カタカナを列挙した文字列をセットする
    strHan = "｡｢｣､･ｦｧｨｩｪｫｬｭｮｯｰｱｲｳｴｵｶｷｸｹｺｻｼｽｾｿﾀﾁﾂﾃﾄﾅﾆﾇﾈﾉﾊﾋﾌﾍﾎﾏﾐﾑﾒﾓﾔﾕﾖﾗﾘﾙﾚﾛﾜﾝﾞﾟ㈱ ㈲ ㈹ 　"
    
    '引数として受け取った文字列を1文字ずつ取り出して変数strHanの文字列に
    '該当するかチェックする。
    For i = 1 To Len(strChkData)
        If InStr(strHan, Mid(strChkData, i, 1)) <> 0 Then
            CheckHankaku = False
            Exit Function
        End If
    Next i
    
    CheckHankaku = True
    
End Function



Attribute VB_Name = "社労士切替"
Attribute VB_Base = "0{8A40805D-5F42-4219-B9F7-D87CD7D9FA58}{1B801634-D9F5-4B9E-90BA-5674DFB59D66}"
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 Sub CommandButton1_Click()
    Dim i As Integer
    Dim No As String
    If Trim(TextBox4.Value) = "" Then
        MsgBox "社労士データが登録されていないデータは切り替えることができません。", 16, "切替"
        Exit Sub
    End If
        If Trim(TextBox10.Value) = "" Then
        MsgBox "社労士コードが不正です。", 16, "切替"
        Exit Sub
    End If
    If MsgBox("申請者情報を切り替えますか？", 1 + 32, "申請者データ") <> 1 Then Exit Sub
    For i = 1 To 5 '読み込むファイル名の末尾の番号を取得する
        If Controls("OptionButton" & i).Value = True Then
            No = Format(i, "#")
        Exit For
    End If
    
    Next
    If No = "1" Then '１は空欄にする
        No = ""
    End If
    Dim MyF As String
    Application.Calculation = xlCalculationManual
    With Workbooks("DaMenu.xls").Worksheets("標準報酬月額")
            For i = 1 To 10
                .Cells(150 + i, 7).Value = Controls("TextBox" & i).Value
            Next
        .Cells(150, 8).Value = No '印
    End With
'    With Worksheets("SHFD0006")
'        .Cells(1, 2).Value = TextBox10.Value
'        .Cells(3, 1).Value = TextBox4.Value
'    End With
    
    '基本情報のパス
   Worksheets("DATA").Cells(2, 2).Value = ThisWorkbook.path & "\Da保存\電子申請申請者\申請者情報" & Combobox1.Value & ".txt"
'   Worksheets("DATA").Cells(31, 2).Value = ThisWorkbook.path & "\Da保存\電子申請申請者\申請者情報" & Combobox1.Value & ".xml"
        
    'マスター.TextBox3.Value = TextBox4.Value
    'マスター.TextBox4.Value = TextBox10.Value
    
    Application.Calculation = xlCalculationAutomatic
    MsgBox "切り替えました。", 64, "申請者データの切替"
    Unload Me
End Sub
Private Sub OptionButton1_Click()
Call 事務所情報の読込("")
End Sub
Private Sub OptionButton2_Click()
Call 事務所情報の読込("2")
End Sub
Private Sub OptionButton3_Click()
Call 事務所情報の読込("3")
End Sub
Private Sub OptionButton4_Click()
Call 事務所情報の読込("4")
End Sub
Private Sub OptionButton5_Click()
Call 事務所情報の読込("5")
End Sub

Private Sub UserForm_Initialize()
    Dim No As String
    Dim i As Integer
    Dim n As Integer
    
    No = Workbooks("DaMenu.xls").Worksheets("標準報酬月額").Cells(150, 8).Value
    If No = "" Then '空欄だったら
        No = "1"
    End If
    Controls("OptionButton" & No).Value = True
    
    For i = 1 To 5
         Combobox1.AddItem i
    Next
    '基本情報のパス
    n = Workbooks(Worksheets("DATA").Cells(1, 1).Value).Worksheets("会社情報").Cells(86, 2).Value
    If n = 0 Then n = 1
    Combobox1.Value = n
    
End Sub
Sub 事務所情報の読込(No As String)
    Dim i As Integer
    Dim TextFilename As String
    Dim MyStr As String
    On Error GoTo ERRORC
    For i = 1 To 10
           Controls("TextBox" & i).Value = ""
    Next
        
    TextFilename = Workbooks("DaMenu.xls").path & "\DaProcess\MyTool\ZimusyoJoho" & No & ".dat"
    
    Open TextFilename For Input As #1
        For i = 1 To 10
            Input #1, MyStr
'20091029 kon
'            If MyStr = "" Then Exit For
            Controls("TextBox" & i).Value = MyStr
        Next
    Close #1

Exit Sub
ERRORC:
For i = 1 To 10
           Controls("TextBox" & i).Value = ""
        Next
On Error Resume Next
Close #1
On Error GoTo 0
End Sub



Attribute VB_Name = "社会社情報"
Attribute VB_Base = "0{4CA5D07A-A43E-42C5-9781-4CE8DADDA52D}{F6C4EBEB-9647-44B1-BEF3-68C2563E3E75}"
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
Dim i As Integer
Dim SS As Worksheet
Dim msg As Integer
Dim strg As String
Dim n, m As Integer
Dim nn As Integer
Private Sub UserForm_Initialize()
    Dim ファイル名 As String
    Dim FileName As String
    
    ファイル名 = Left(Worksheets("DATA").Cells(1, 1).Value, Len(Worksheets("DATA").Cells(1, 1).Value) - 6)
    FileName = Workbooks("DaMenu.xls").path & "\DaProcess\MyTool\提出代行\" & ファイル名 & ".txt"
        
        TextBox1.Value = GetTextData(18, FileName)
        TextBox2.Value = GetTextData(19, FileName)
        TextBox3.Value = GetTextData(20, FileName)
        TextBox4.Value = GetTextData(16, FileName)
        TextBox5.Value = GetTextData(17, FileName)
        TextBox6.Value = GetTextData(11, FileName)
        TextBox7.Value = GetTextData(7, FileName)
        TextBox8.Value = GetTextData(9, FileName)
        TextBox9.Value = GetTextData(13, FileName)
        
        
        
    Call Check
End Sub
Private Sub Command更新_Click()
    Dim ファイル名 As String
    Dim FileName As String
    
     Call Check
     If nn = 1 Then Exit Sub
     
     If MsgBox("データを変更しますか？", 1 + 32, "会社情報") <> 1 Then Exit Sub
       
    ファイル名 = Left(Worksheets("DATA").Cells(1, 1).Value, Len(Worksheets("DATA").Cells(1, 1).Value) - 6)
    FileName = Workbooks("DaMenu.xls").path & "\DaProcess\MyTool\提出代行\" & ファイル名 & ".txt"
        
      SetTextData 18, TextBox1.Value, FileName
      SetTextData 19, TextBox2.Value, FileName
      SetTextData 20, TextBox3.Value, FileName
      SetTextData 16, TextBox4.Value, FileName
      SetTextData 17, TextBox5.Value, FileName
      SetTextData 11, TextBox6.Value, FileName
      SetTextData 7, TextBox7.Value, FileName
      SetTextData 9, TextBox8.Value, FileName
      SetTextData 13, TextBox9.Value, FileName
      
   
   社マスター.TextBox2.Value = TextBox7.Value
   Unload Me
   
End Sub
Sub Check()
nn = 0
If 半角数値(TextBox1.text) = 2 Then
Else
MsgBox "「事業所整理記号」（半角数字2文字）が不正です", 16, "入力規則エラー"
nn = 1
TextBox1.SetFocus
TextBox1.SelStart = 0
TextBox1.SelLength = Len(TextBox1.text)
Exit Sub
End If

If 半角文字(TextBox2.text) >= 1 And 半角文字(TextBox2.text) <= 4 Then
Else
MsgBox "「事業所整理記号」（半角文字4文字）が不正です", 16, "入力規則エラー"
nn = 1
TextBox2.SetFocus
TextBox2.SelStart = 0
TextBox2.SelLength = Len(TextBox2.text)
Exit Sub
End If

If 半角数値(TextBox3.text) >= 1 And 半角数値(TextBox3.text) <= 5 Then
Else
MsgBox "「事業所整理記号」（半角数字5文字以内）が不正です", 16, "入力規則エラー"
nn = 1
TextBox3.SetFocus
TextBox3.SelStart = 0
TextBox3.SelLength = Len(TextBox3.text)
Exit Sub
End If

If 半角数値(TextBox4.text) = 3 Then
Else
MsgBox "「郵便番号」（半角数字3文字）が不正です", 16, "入力規則エラー"
nn = 1
TextBox4.SetFocus
TextBox4.SelStart = 0
TextBox4.SelLength = Len(TextBox4.text)
Exit Sub
End If


If 半角数値(TextBox5.text) = 4 Then
Else
MsgBox "「郵便番号」（半角数字4文字）が不正です", 16, "入力規則エラー"
nn = 1
TextBox5.SetFocus
TextBox5.SelStart = 0
TextBox5.SelLength = Len(TextBox5.text)
Exit Sub
End If


If 無効文字(TextBox6.text) = 0 And LenMbcs(TextBox6.text) >= 1 And LenMbcs(TextBox6.text) <= 75 Then
Else
MsgBox "「事業所所在地」（全角文字37文字以内）が不正です", 16, "入力規則エラー"
nn = 1
TextBox6.SetFocus
TextBox6.SelStart = 0
TextBox6.SelLength = Len(TextBox6.text)
Exit Sub
End If

If 無効文字(TextBox7.text) = 0 And LenMbcs(TextBox7.text) >= 1 And LenMbcs(TextBox7.text) <= 50 Then
Else
MsgBox "「事業所名称」（全角文字25文字以内）が不正です", 16, "入力規則エラー"
nn = 1
TextBox7.SetFocus
TextBox7.SelStart = 0
TextBox7.SelLength = Len(TextBox7.text)
Exit Sub
End If

If 無効文字(TextBox8.text) = 0 And LenMbcs(TextBox8.text) >= 1 And LenMbcs(TextBox8.text) <= 25 And スペース(TextBox8.text) = 1 Then
Else
MsgBox "「事業主氏名」（全角文字12文字以内）が不正です", 16, "入力規則エラー"
nn = 1
TextBox8.SetFocus
TextBox8.SelStart = 0
TextBox8.SelLength = Len(TextBox8.text)
Exit Sub
End If

If 半角数値(TextBox9.text) >= 1 And 半角数値(TextBox9.text) <= 12 Then
Else
MsgBox "「電話番号」（半角数字12文字以内）が不正です", 16, "入力規則エラー"
nn = 1
TextBox9.SetFocus
TextBox9.SelStart = 0
TextBox9.SelLength = Len(TextBox9.text)
Exit Sub
End If



End Sub


Attribute VB_Name = "Module1"
Option Explicit
Public Enum DATA_TYPE
    DATA_TYPE_CHANGE_REPORT = 0
    DATA_TYPE_NO3_CHANGE = 1
    DATA_TYPE_NO3_LOSS = 2
    DATA_TYPE_NO3_DEATH = 3
End Enum
''' 届出書コード
Public Const CODE_CHANGE_REPORT As String = "22027051" '異動届
Public Const CODE_NO3_CHANGE As String = "52805011" '3号取得
Public Const CODE_NO3_LOSS As String = "52805021" '3号喪失
Public Const CODE_NO3_DEATH As String = "52805031" '3号死亡
Public Sub 初期処理()
    Dim ファイル名   As String
    Dim TextFilename As String
    Dim MyStr        As String
    Dim FileName     As String
    Dim n As Long
    
    With ThisWorkbook.Worksheets("DATA")
        ファイル名 = Left(.Cells(1, 1).Value, Len(.Cells(1, 1).Value) - 6)
        
        '存在するかチェック
        FileName = Workbooks("DaMenu.xls").path & "\DaProcess\MyTool\提出代行\" & ファイル名 & ".txt"
        If Dir(FileName) = "" Then
            MsgBox "電子申請用の会社情報が登録されていません。", 16, AAA
            ThisWorkbook.Close False
            Exit Sub
        End If
        
        '基本情報のパス
        n = Workbooks(.Cells(1, 1).Value).Worksheets("会社情報").Cells(86, 2).Value
        If n = 0 Then n = 1
        .Cells(2, 2).Value = Workbooks("DaMenu.xls").path & "\DaProcess\Da保存\電子申請申請者\申請者情報" & n & ".txt"
        
        If Not Application.Run("EAppCom.xla!IsFileExist", .Cells(2, 2).Value) Then
            MsgBox "電子申請用の申請者情報が登録されていません。", 16, AAA
            ThisWorkbook.Close False
            Exit Sub
        End If
        
        '#2465 20120702
        '届の社労士名のために、データを取得する
        .Cells(11, 2).Value = Replace(GetTextData(16, .Cells(2, 2).Value), """", vbNullString)
        'END#2465 20120702
        
'        20100922masa提出代行証明書の収録しているフォルダ名称（参照パス途中）に、,や/などの記号が含まれるため。
'        Open filename For Input As #1
'            For i = 1 To 3
'                Input #1, MyStr
'                .Cells(2 + i, 2).Value = MyStr
'                MyStr = ""
'            Next
'        Close #1
'        '提出代行パス
        .Cells(3, 2).Value = GetTextData(1, FileName)
        .Cells(4, 2).Value = GetTextData(2, FileName)
        .Cells(5, 2).Value = GetTextData(3, FileName)
        
        '提出先コードと名称
        .Cells(6, 2).Value = GetTextData(21, FileName)
        .Cells(7, 2).Value = GetTextData(23, FileName)

        'shfd0006チェック
        .Cells(15, 2).ClearContents
        '添付ファイルクリア
        Range(.Cells(120, 2), .Cells(134, 2)).ClearContents
        
    End With
    
    
'   CSVシートをクリア
    ThisWorkbook.Worksheets("SHFD0006").Cells.ClearContents
    
    Worksheets("社ＣＳＶ").Select
    'マスター.Show
End Sub

Sub クリア()
    Sheets("DATA").Select
    Range("A1").ClearContents
    Range("B2").ClearContents
    Range("B3").ClearContents
    Range("B6").ClearContents
    Range("B7").ClearContents
    Range("B23").ClearContents
    Range("B24").ClearContents
    Sheets("総括票").Select
    Range("B9").ClearContents
    Range("B10").ClearContents
    Range("B12").ClearContents
    Range("B13").ClearContents
    Range("B14").ClearContents
    Range("B16").ClearContents
    Range("B17").ClearContents
    Range("B18").ClearContents
    Range("B19").ClearContents
    Range("B25").ClearContents
    Range("B27").ClearContents
    Range("B28").ClearContents
    Range("B29").ClearContents
    Range("B30").ClearContents
    Range("B31").ClearContents
    Range("B32").ClearContents
    Range("B33").ClearContents
    Range("B34").ClearContents
    Range("B36").ClearContents
    Range("B37").ClearContents
    Range("B38").ClearContents
    Range("B40").ClearContents
    Range("B41:B44").ClearContents
   Sheets("MENU").Select
End Sub
Sub 終了へ()
    If MsgBox("終了しますか？", 1 + 32, AAA) <> 1 Then Exit Sub
    Application.DisplayAlerts = (False)        'メッセージ非表示
    Application.Run "DaAddin.xla!閉じる"

End Sub
Sub 社マスターへ()
    Worksheets("社ＣＳＶ").Select
    社マスター.Show
End Sub
'Sub 雇マスターへ()
'    Worksheets("雇ＣＳＶ").Select
'    雇マスター.Show
'End Sub
Sub 住所変更届へ()
    '20140416 kon 24974
    異動届.StartUpPosition = 0
    異動届.Show
End Sub
Sub 社保総括票へ()

    If Worksheets("DATA").Cells(15, 2).Value = "" Then '存在するかチェック
        MsgBox "CSVファイルが作成されていません。", 16, AAA
        Exit Sub
    End If

    社総括票.Show
End Sub
'Sub 雇取得届へ()
'    雇取得.Show
'End Sub
'Sub 雇総括票へ()
'    雇総括票.Show
'End Sub
Sub 戻る()
    ThisWorkbook.Close False
    
End Sub
Public Function NoGet(ByVal flg As Boolean) As String

    Dim dbCon As New ADODB.Connection
    Dim dbRes As New ADODB.Recordset
    Dim strSQL As String
    Dim ret As String
    Dim pos As Long
    
    dbCon.Provider = "Microsoft.Jet.OLEDB.4.0"
    dbCon.Open ThisWorkbook.path & "\egovrecord.mdb"
    
    '20100929 YBNO 1519 採番問題
    strSQL = "SELECT max(id) FROM 申請データ"
    strSQL = strSQL & " WHERE Len(Trim(FD通番)) <> 0 AND 状況 <> 99"
    
    pos = 8
    If flg Then pos = 6
    
    If Trim(Sheets("DATA").Cells(pos, 2)) <> "" Then
    '20101021 YB 2314 雇用保険FDNOがインクリメントしない
        strSQL = strSQL & " AND 提出先コード = """ & Sheets("DATA").Cells(pos, 2) & """"
    'END 20101021 YB 2314 雇用保険FDNOがインクリメントしない
    End If
    
    strSQL = "SELECT FD通番 FROM 申請データ WHERE id = (" & strSQL & ")"
    
    If dbCon.Execute(strSQL).EOF Then
        ret = vbNullString
        NoGet = ret
        Exit Function
    End If
    
    ret = Format(CLng(dbCon.Execute(strSQL)(0)) + 1, "000")

    If ret > 999 Then
        ret = "001"
    End If
     '20100929 YBNO 1519 採番問題 END
    Set dbCon = Nothing
    
    NoGet = ret
    
End Function
Sub ヘルプへ()
    Dim URL As String, IE As Object
    Set IE = CreateObject("InternetExplorer.Application")
    URL = "http://plus-samurai.jp/daityo/?p=5516"
    With IE
        .Navigate (URL)
        .Visible = True
    End With
    Set IE = Nothing
End Sub

'''
''' SHFD0006を見てこのCSVに登録されているデータの数を返す
'''
Public Function CountSHFD0006Data(ByVal dt As DATA_TYPE) As Long

    Dim SearchString As String
    Dim EndPoint As Long

    EndPoint = Worksheets("SHFD0006").Cells(6, 1).End(xlDown).Row

    Select Case dt
        Case DATA_TYPE_CHANGE_REPORT
            SearchString = CODE_CHANGE_REPORT
        Case DATA_TYPE.DATA_TYPE_NO3_CHANGE
            SearchString = CODE_NO3_CHANGE
        Case DATA_TYPE.DATA_TYPE_NO3_LOSS
            SearchString = CODE_NO3_LOSS
        Case DATA_TYPE.DATA_TYPE_NO3_DEATH
            SearchString = CODE_NO3_DEATH
    End Select
    
    CountSHFD0006Data = Application.WorksheetFunction.CountIf(Worksheets("SHFD0006").Range("A6:A" & CStr(EndPoint)), SearchString)

End Function
'''
''' 健保Noから個人情報の何列目の人なのか返す
'''
Public Function GetRowBYKenpoNo(ByVal DaFileName As String, ByVal KenpoNo As String) As Long

    Dim i As Long
    Dim EndPoint As Long

    EndPoint = Workbooks(DaFileName).Worksheets("個人情報").Cells(6, 1).End(xlDown).Row
   
    For i = 6 To EndPoint
        If Workbooks(DaFileName).Worksheets("個人情報").Cells(i, 4).Value = KenpoNo Then
            GetRowBYKenpoNo = i
            Exit Function
        End If
    Next i

    GetRowBYKenpoNo = 0
    
End Function
'''
''' 健保NoからSHFDの何列目か返す
'''
Public Function GetRowForSHDFByKenpoNo(ByVal KenpoNo As String, ByRef LinkNo As String) As Long

    Dim i As Long
    Dim EndPoint As Long

    EndPoint = ThisWorkbook.Worksheets("SHFD0006").Cells(6, 1).End(xlDown).Row
   
    For i = 6 To EndPoint
        If ThisWorkbook.Worksheets("SHFD0006").Cells(i, 1).Value = CODE_CHANGE_REPORT Then
            If ThisWorkbook.Worksheets("SHFD0006").Cells(i, 4).Value = KenpoNo Then
                GetRowForSHDFByKenpoNo = i
                LinkNo = ThisWorkbook.Worksheets("SHFD0006").Cells(i, 128).Value
                Exit Function
            End If
        End If
    Next i

    GetRowForSHDFByKenpoNo = 0
    
End Function
'''
''' 同じリンク番号の3号届のデータの列目を返す
'''
Public Function GetRowByLinkNo(ByVal LinkNo As String) As Long

    Dim index As Long
    Dim EndPoint As Long
    Dim i As Long
    
    EndPoint = Worksheets("SHFD0006").Cells(6, 1).End(xlDown).Row

    For i = 6 To EndPoint
        Select Case Worksheets("SHFD0006").Cells(i, 1).Value
            Case CODE_NO3_CHANGE
                index = 43
            Case CODE_NO3_LOSS
                index = 29
            Case CODE_NO3_DEATH
                index = 30
            Case Else
                index = -1
        End Select
        If index <> -1 Then
            If Worksheets("SHFD0006").Cells(i, index).Value = LinkNo Then
                GetRowByLinkNo = i
…