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 = "Sheet3"
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 = "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 = "Function1"
Option Explicit
Public Const AAA As String = "賞与支払届"
Dim i As Integer
Dim n As Integer
Dim strg1 As String
'本当のバイト数
Function LenMbcs(ByVal str As String)
    LenMbcs = LenB(StrConv(str, vbFromUnicode))
End Function
'半角カナの数
Function 半角カナ(strg As String)

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)
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)
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)
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)
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)
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
Mydate2 = DateSerial(Mid(text, 3, 2) + Mydate2, Mid(text, 5, 2), Mid(text, 7, 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(32, 2).Value = Denwa
                    Exit Function
                    Else
                    .Cells(32, 2).Value = Mid(Denwa, 1, j - 1)
                End If
                If k = 0 Then 'ＴＥＬ2
                    .Cells(33, 2).Value = Mid(Denwa, j + 1, Len(Denwa) - j)
                    Exit Function
                    Else
                    .Cells(33, 2).Value = Mid(Denwa, j + 1, k - j - 1)
                End If
                .Cells(34, 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 Sub Body(f As TextFile, Wh As String)
             '総括票XML作成
             With Worksheets(Wh)
                 For i = 1 To .Cells(1005, 1).End(xlUp).Row
                     If .Cells(i, 2).Value = "" Then
                        f.TextWriteLine .Cells(i, 1).Value & .Cells(i, 3).Value
                         Else
                        f.TextWriteLine .Cells(i, 1).Value & .Cells(i, 2).text & .Cells(i, 3).Value
                     End If
                 Next
            End With
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
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{367CB8E0-A67E-43C1-92B8-ECD9031E9452}{D79AA824-DD55-45E6-8052-A97E643C6844}"
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{523A25EB-4CBE-44F3-A1B9-0E074C0A2FC0}{5E9A8758-0420-4B02-94AA-9C3A9EDAEA9C}"
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 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"
        
        '#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



    'マスター.Show

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 賞与へ()
    賞与支払届.Show
End Sub
Sub 社保総括票へ()
    社総括票.Show
End Sub
'Sub 雇取得届へ()
'    雇取得.Show
'End Sub
'Sub 雇総括票へ()
'    雇総括票.Show
'End Sub
Sub 戻る()
    DoEvents
    ThisWorkbook.Close False
    DoEvents
End Sub
Sub ボタン1_Click()
    Worksheets("社ＣＳＶ").Select

End Sub
'Sub 戻る1()
'    UserForm1.Show
'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


Attribute VB_Name = "APIModule"
Private Type STARTUPINFO
    CB As Long
    lpReserved As String
    lpDesktop As String
    lpTitle As String
    dwX As Long
    dwY As Long
    dwXSize As Long
    dwYSize As Long
    dwXCountChars As Long
    dwYCountChars As Long
    dwFillAttribute As Long
    dwFlags As Long
    wShowWindow As Integer
    cbReserved2 As Integer
    lpReserved2 As Long
    hStdInput As Long
    hStdOutput As Long
    hStdError As Long
End Type

Private Type PROCESS_INFORMATION
   hProcess As Long
   hThread As Long
   dwProcessID As Long
   dwThreadID As Long
End Type

Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal _
   hHandle As Long, ByVal dwMilliseconds As Long) As Long

Private Declare Function CreateProcessA Lib "kernel32" (ByVal _
   lpApplicationName As Long, ByVal lpCommandLine As String, ByVal _
   lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, _
   ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, _
   ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As Long, _
   lpStartupInfo As STARTUPINFO, lpProcessInformation As _
   PROCESS_INFORMATION) As Long

Private Declare Function CloseHandle Lib "kernel32" (ByVal _
   hObject As Long) As Long

Private Const NORMAL_PRIORITY_CLASS = &H20&
Private Const INFINITE = -1&
'---------------------------------------------------------
Private Declare Function FindWindow Lib "USER32" Alias _
        "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib "USER32" _
        Alias "FindWindowExA" _
        (ByVal hwndParent As Long, ByVal hwndChildAfter As Long, _
        ByVal lpszClass As String, ByVal lpszWindow As String) As Long
Private Declare Function SendMessage Lib "USER32" Alias _
        "SendMessageA" (ByVal hwnd As Long, _
        ByVal Msg As Long, _
        ByVal wParam As Long, lParam As Any) As Long
Private Declare Function GetWindow Lib "USER32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Const BM_CLICK = &HF5
Private Const WM_SETTEXT As Long = &HC
Private Const WM_ACTIVATE = &H6
'--------------------------------------------------------------------
'Win32API宣言
Public Declare Function OpenClipboard Lib "USER32" (ByVal hwnd As Long) As Long
Public Declare Function EmptyClipboard Lib "USER32" () As Long
Public Declare Function CloseClipboard Lib "USER32" () As Long
Public Declare Function SetClipboardData Lib "USER32" (ByVal uFormat As Long, ByVal hData As Long) As Long
Public Declare Function GlobalAlloc Lib "kernel32" (ByVal uFlag As Long, ByVal dwBytes As Long) As Long
Public Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Public Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
'本来はＣ言語用の文字列コピーだが、２つ目の引数をStringとしているので変換が行われた上でコピーされる。
Public Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (ByVal lpString1 As Long, ByVal lpString2 As String) As Long

'定数宣言
Public Const GMEM_MOVEABLE         As Long = &H2
Public Const GMEM_ZEROINIT         As Long = &H40
Public Const GHND                  As Long = (GMEM_MOVEABLE Or GMEM_ZEROINIT)
Public Const CF_TEXT               As Long = 1
Public Const CF_OEMTEXT            As Long = 7
''' YBNO 255 64bit対応 笹原
Public Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" ( _
ByVal hwnd As Long, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long

Public Const SW_NORMAL = 1
Public Const SW_MAXIMIZE = 3
Public Const SW_MINIMIZE = 6
''' END YBNO 255 64bit対応 笹原
Public Function CopyText(str As String) As Boolean
    Dim hGlobal As Long
    Dim length As Long
    Dim p As Long
    
    '戻り値をとりあえず、Falseに設定しておく。
    CopyText = False
    If OpenClipboard(0) <> 0 Then
        If EmptyClipboard() <> 0 Then
            '長さの算出(本来はUnicodeから変換後の長さを使うほうがよい)
            length = LenB(str) + 1
            'コピー先の領域確保
            hGlobal = GlobalAlloc(GHND, length)
            p = GlobalLock(hGlobal)
            '文字列をコピー
            Call lstrcpy(p, str)
            'クリップボードに渡すときにはUnlockしておく必要がある
            Call GlobalUnlock(hGlobal)
            'クリップボードへ貼り付ける
            Call SetClipboardData(CF_TEXT, hGlobal)
            'クリップボードをクローズ
            Call CloseClipboard
            'コピー成功
…