Malicious Office (OLE) — malware analysis report

Static analysis result for SHA-256 8cf79f1b767fe6eb…

MALICIOUS

Office (OLE)

766.0 KB Created: 2010-11-01 01:33:34 Authoring application: Microsoft Excel First seen: 2018-07-14
MD5: 25b35f7b4f9297d71b142536004f8330 SHA-1: 3010f60ee6b07b27458ae40becf8825e7e0fa869 SHA-256: 8cf79f1b767fe6ebaf140b3e365be3aa8fe0c5f69d18035fd68e1b3b3515e6c7
102 Risk Score

Malware Insights

MITRE ATT&CK
T1059.005 Visual Basic T1566.001 Spearphishing Attachment T1204.002 Malicious File

The file is a Microsoft Excel document containing VBA macros, indicated by the OLE_VBA_MACROS heuristic. The presence of a ShellExecute API reference and a CreateObject call suggests the macros are designed to execute external code. The VBA script attempts to run functions from 'EAppCom.xla', which likely facilitates the execution of a second-stage payload, possibly downloaded from the embedded URL.

Heuristics 4

  • Reference to ShellExecute API high SC_STR_SHELLEXEC
    Reference to ShellExecute API
  • VBA macros detected medium 1 related finding OLE_VBA_MACROS
    Document contains VBA macro code
  • CreateObject call high OLE_VBA_CREATEOBJ
    CreateObject call
    Matched line in script
            Dim path() As String                             '様式固有の添付ファイルパス
        Set dic = CreateObject("Scripting.Dictionary")   '添付ファイルの変更前と変更後を紐付ける連想配列
        daikoPath = ""                                   '提出代行パスの初期化
  • Embedded URL info EMBEDDED_URL
    One or more URLs were extracted from the document. The URL itself is not a detection — see the per-URL labels for which channel (macro, JS, link annotation, document body, ...) reached each URL.
    URL https://www.cells.co.jp/daityo-s/wp-content/uploads/manual/koyoukeizoku.pdf In document text (OLE body)

Extracted artifacts 1

Files carved from inside the sample during analysis.

FilenameKindSourceSize
macros.bas vba-macro oletools.olevba.extract_macros (decoded VBA source) 54069 bytes
SHA-256: 451f698c0d6ed211b0484826ba95e68490eecefa6d0d7b9d613f53a471ad3638
Preview script
First 1,000 lines of the extracted script
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 = "プレビュー"
Attribute VB_Base = "0{EA1C2497-6CB4-4C1E-B2A7-061F5B9CD392}{F6A9A15D-95FE-43C9-AB55-D8CA09FE13B3}"
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 CommandButton2_Click()
    '''YBNO 18323
    '添付.Show
    Application.Run "EAppCom.xla!DisplayAttach", 2, 1, ThisWorkbook
    ''' END YBNO18323
End Sub

Private Sub CommandButton3_Click()
  Dim strFName As String
        strFName = _
            Application.GetOpenFilename _
                 ("(*.*),*.*")
        If (strFName = "False") Then
            Exit Sub
        End If
        TextBox100.Value = strFName
        
        '#38985 SHIHO===========================================================================================
        
        If Application.Run("EAppCom.xla!isNotDisPlayChar", strFName) Then
            MsgBox "ファイル名に使用できない文字が含まれています。", vbCritical + vbOKOnly, "添付ファイルエラー"
            Exit Sub
        End If
        
        '=======================================================================================================
        
        '#39231 hara 20180416
        If Application.Run("EAppCom.xla!isSameFile", strFName, TextBox5) Then
            MsgBox "提出代行証明書とファイル名が同一です。", vbCritical + vbOKOnly, "添付ファイルエラー"
            TextBox100.Value = ""
            Exit Sub
        End If
        '#39231 hara ここまで

End Sub

Private Sub Label94_Click()
    Dim strFName As String
        strFName = _
            Application.GetOpenFilename _
                 ("(*.*),*.*")
        If (strFName = "False") Then
            Exit Sub
        End If
        TextBox100.Value = strFName
End Sub

Private Sub CommandButton4_Click()
SelectAttachFile TextBox100.Text
End Sub

Private Sub OptionButton1_Click() '提出代行ＰＤＦ
    SetDaikouSya 1, TextBox5, ThisWorkbook
End Sub
Private Sub OptionButton2_Click() '提出代行ＤＯＣ
    SetDaikouSya 2, TextBox5, ThisWorkbook
End Sub
Private Sub OptionButton3_Click() '提出代行利用しない(20100914masa)
    SetDaikouSya 3, TextBox5, ThisWorkbook
End Sub
Public Sub SetDaikouSya(ByVal no As Long, ByRef tb As MSForms.TextBox, ByRef wb As Workbook)

    If no = 1 Then
        tb.Value = wb.Worksheets("DATA").Cells(4, 2).Value
        tb.ForeColor = "&H000000"
        wb.Worksheets("DATA").Cells(10, 2).Value = "PDF"
    ElseIf no = 2 Then
        tb.Value = wb.Worksheets("DATA").Cells(5, 2).Value
        tb.ForeColor = "&H000000"
        wb.Worksheets("DATA").Cells(10, 2).Value = "DOC"
    Else
        tb.Value = vbNullString
        tb.ForeColor = "&H00E0E0E0"
        wb.Worksheets("DATA").Cells(10, 2).Value = "利用しない"
    End If

    If Me.WebWindow.LocationURL <> "" Then
        Call XML作成("証明", ThisWorkbook.Worksheets("DATA").Cells(82, 2).Value)
        Call XML作成("登録", ThisWorkbook.Worksheets("DATA").Cells(97, 2).Value)
        Me.WebWindow.Refresh
        Me.WebBrowser1.Refresh
    End If

End Sub

Private Sub UserForm_Activate()
     Dim ファイル名 As String
    Dim FileName As String
    Dim i As Integer
    Dim MyStr As String
        
'    提出先
    TextBox6.Value = Worksheets("DATA").Cells(8, 2).Value
    TextBox1.Value = Worksheets("DATA").Cells(9, 2).Value

'    社労士情報
    FileName = Worksheets("DATA").Cells(2, 2).Value
    Open FileName For Input As #1
        For i = 1 To 16
            Input #1, MyStr
            TextBox3.Value = MyStr
        Next
    Close #1

    
'    日付
    Text1.Value = Format(Date, "yyyymmdd")
    
'    提出代行
    With Worksheets("DATA")
        If .Cells(10, 2).Value = "PDF" Then Me.OptionButton1.Value = True
        If .Cells(10, 2).Value = "DOC" Then Me.OptionButton2.Value = True
        
        'YB27996 20150622 fuku
'        If .Cells(10, 2).Value = "利用しない" Then Me.OptionButton3.Value = True
        If .Cells(10, 2).Value = "利用しない" Then Me.OptionButton3.Value = False

    End With
    
'   本人同意書
    TextBox100.Value = Worksheets("DATA").Cells(11, 2).Value
    
    '    チェック
    If TextBox1.Value = "" Or TextBox3.Value = "" Then
        MsgBox "必要な情報が設定されていません。", 16, AAA
        Unload Me
        Application.Run "DaAddin.xla!閉じる"
        Exit Sub
    End If
    If Controls("Text" & 1).Value = "" Then
        MsgBox "必要な情報が設定されていません。", 16, AAA
        Application.Run "DaAddin.xla!閉じる"
        Unload Me
        Exit Sub
    End If
    
    WebWindow.Navigate ThisWorkbook.path & "\スタイルシート\" & ThisWorkbook.Worksheets("DATA").Cells(85, 2).Value
    WebBrowser1.Navigate ThisWorkbook.path & "\スタイルシート\" & ThisWorkbook.Worksheets("DATA").Cells(100, 2).Value

End Sub
Private Sub CommandButton1_Click()
'総括票XML作成の準備
        Dim i As Integer
        Dim strPathName As String
        Dim myFso     As Scripting.FileSystemObject
        Dim FileName As String
        Dim MyStr As String
        Dim ファイル名 As String
        Dim フォルダ As String
        Dim 申ID As String
        Dim 手ID As String
        '#37486  ito 20171114　添付ファイル正規化　------------------------------------------------------
        Dim dic As Object                                '紐づけを行う連想配列
        Dim daikoPath As String                          '提出代行のパス
        Dim path() As String                             '様式固有の添付ファイルパス
        Set dic = CreateObject("Scripting.Dictionary")   '添付ファイルの変更前と変更後を紐付ける連想配列
        daikoPath = ""                                   '提出代行パスの初期化
        ReDim path(0)
        '#37486  ----------------------------------------------------------------------------------------
        
                
        '添付ファイルチェック
        If 添付Check = False Then Exit Sub

        If MsgBox("電子申請データを作成しますか？", 1 + 32, "作成") <> 1 Then Exit Sub
        申ID = Worksheets("DATA").Cells(82, 2).Value
        手ID = Worksheets("DATA").Cells(92, 2).Value
        
        Application.ScreenUpdating = False


'       提出代行
        '#37486  ito 20171114　添付ファイル正規化　------------------------------------------------------------------------------------------
        'If OptionButton3.Value = False Then Worksheets("DATA").Cells(61, 2).Value = Dir(TextBox5.Value)  '20100913masa 提出代行なしに対応
        If OptionButton3.Value = False Then
            Worksheets("DATA").Cells(61, 2).Value = Dir(TextBox5.Value)
            daikoPath = TextBox5.Value
        Else
            ThisWorkbook.Worksheets("DATA").Cells(61, 2).ClearContents
        End If
        '本人同意書
        If Trim(TextBox100.Value) <> "" Then
            path(UBound(path)) = TextBox100.Value
            ThisWorkbook.Worksheets("DATA").Cells(11, 2).Value = TextBox100.Value
        Else
            ThisWorkbook.Worksheets("DATA").Cells(11, 2).ClearContents
        End If
        
        '変更前と変更後を紐づけるディクショナリ配列を作成
        Application.Run "EAppCom.xla!AssociatedFiles", ThisWorkbook.Worksheets("DATA").Range("B61:B71"), daikoPath, path, dic
        '#37486  -----------------------------------------------------------------------------------------------------------------------------
        
        
'       保存するフォルダを作る
        フォルダ = Format(Date, "YYYYMMDD") & Application.Run("EAppCom.xla!NowTimeString")
        strPathName = ThisWorkbook.path & "\" & "申請データ\" & フォルダ
        ''' YBNO 16940
        'MkDir strPathName
        Application.Run "EAppCom.xla!IsExistFolder", strPathName
        
'       入力された情報をもとに再度XMLを作成
'        Call XML編集
       
        Call XML作成("登録", ThisWorkbook.Worksheets("DATA").Cells(82, 2).Value)
        Call XML作成("証明", ThisWorkbook.Worksheets("DATA").Cells(97, 2).Value)
        
        
'        提出代行JPG,スタイルシート、取得届ＸＭＬを申請フォルダに入れる
        Set myFso = New Scripting.FileSystemObject
        If OptionButton3.Value = False Then myFso.CopyFile TextBox5.Value, strPathName & "\" '20100913masa 提出代行なしに対応
        myFso.CopyFile ThisWorkbook.path & "\スタイルシート\999000000000000001.xsl", strPathName & "\"
        myFso.CopyFile ThisWorkbook.path & "\スタイルシート\" & ThisWorkbook.Worksheets("DATA").Cells(82, 2).Value & ".xsl", strPathName & "\"
        myFso.CopyFile ThisWorkbook.path & "\スタイルシート\" & ThisWorkbook.Worksheets("DATA").Cells(85, 2).Value, strPathName & "\"
        myFso.CopyFile ThisWorkbook.path & "\スタイルシート\" & ThisWorkbook.Worksheets("DATA").Cells(97, 2).Value & ".xsl", strPathName & "\"
        myFso.CopyFile ThisWorkbook.path & "\スタイルシート\" & ThisWorkbook.Worksheets("DATA").Cells(100, 2).Value, strPathName & "\"
        If TextBox100.Value <> "" Then '同意書
            '#37486  ito 20171114　添付ファイル正規化
            'Worksheets("DATA").Cells(73, 2).Value = Dir(TextBox100.Value)
            Worksheets("DATA").Cells(73, 2).Value = dic(Dir(TextBox100.Value))
            '20100721masa ドライブが異なるとエラーになる。
'            myFso.CopyFile Worksheets("DATA").Cells(62, 2).Value, strPathName & "\"
            myFso.CopyFile TextBox100.Value, strPathName & "\"
        Else
            Worksheets("DATA").Cells(73, 2).ClearContents
        End If
        With ThisWorkbook.Worksheets("DATA") 'その他添付ファイル
            For i = 0 To 9
                If .Cells(62 + i, 4).Value <> "" Then
                   myFso.CopyFile .Cells(62 + i, 4).Value, strPathName & "\"
                Else
                    .Cells(62 + i, 4).ClearContents
                End If
            Next
        End With
        
        
        '#37486  ito 20171114　添付ファイル正規化
        'Set myFso = Nothing
        '申請データフォルダのファイル名をリネームする
        Application.Run "EAppCom.xla!FileRename", dic, strPathName
        
       
'        申請者情報（kousei.xml)を作成して、作成したフォルダに入れる
        Workbooks.Open FileName:=ThisWorkbook.path & "\XML作成\申請者.xls"
        Workbooks("申請者.xls").Activate
        With ThisWorkbook.Worksheets("DATA")
            Cells(1, 8).Value = strPathName & "\kousei.xml" '保存先を書き込む
            Cells(10, 2).Value = 手ID
            Cells(12, 2).Value = .Cells(91, 2).Value '手続名称
            Cells(135, 2).Value = .Cells(8, 2).Value '提出先コード
            Cells(136, 2).Value = .Cells(9, 2).Value '提出先名称
            Cells(52, 3).Value = .Cells(60, 2).Value '添付ファイル
            Cells(137, 3).Value = .Cells(80, 2).Value '申請書属性情報
            Cells(2, 9).Value = .Cells(2, 2).Value '事務所基本情報
            '提出先社保と会社名
            ファイル名 = Left(.Cells(1, 1).Value, Len(.Cells(1, 1).Value) - 6)
            FileName = Workbooks("DaMenu.xls").path & "\DaProcess\MyTool\提出代行\" & ファイル名 & ".txt"
            Cells(2, 11).Value = FileName               '電子申請会社情報
        End With
        'Application.Run "申請者.xls!作成"
        ''' YBNO16449
        If Trim(ThisWorkbook.Worksheets("DATA").Cells(10, 2).Value) = "利用しない" Then
            Application.Run "申請者.xls!作成", True
        Else
            Application.Run "申請者.xls!作成", False
        End If
        ''' END YBNO16449
        Workbooks("申請者.xls").Close False
        ThisWorkbook.Activate
        
        
        '#37486  ito 20171114　添付ファイル正規化　------------------------------------------------------------------------------------------
        'DATAシートの添付ファイル名を変更前の状態に戻す。2回連続で申請するとエラーとなるため
        If OptionButton3.Value = False Then
            If myFso.FileExists(TextBox5.Value) Then
                Worksheets("DATA").Cells(61, 2).Value = myFso.GetFileName(daikoPath)   '提出代行のファイル名を戻す
            End If
        End If
        If Trim(TextBox100.Value) <> "" Then
            If myFso.FileExists(TextBox100.Value) Then
                Worksheets("DATA").Cells(73, 2).Value = myFso.GetFileName(TextBox100.Value)   '同意書を戻す
            End If
        End If
        Application.Run "EAppCom.xla!FileUndo", ThisWorkbook.Worksheets("DATA").Range("B62:B71"), False   '添付ファイル名1～10を戻す
        
        Set myFso = Nothing
        Set dic = Nothing
        '#37486  -----------------------------------------------------------------------------------------------------------------------------
        
        
'        記録を書き込む
'        Application.Run "EAppCom.xla!DataAdd", strPathName, フォルダ
'        Application.ScreenUpdating = True

        'YBNO 31594  ito 20160506
        '個人番号があるときにログを作る
        '---------------------------------------------
        If ThisWorkbook.Worksheets("登録").Cells(10, 2).Value <> vbNullString And Application.Run("DaAddin.xla!MNMode", True, False) Then
            Dim guid As String
            guid = Workbooks("雇用継続給付.xls").Worksheets("DATA").Cells(10, 1).Value
        
            Dim ComAccount As String
            ComAccount = Application.Run("業務日誌.xlam!GetCompanyData", Workbooks(ThisWorkbook.Worksheets("DATA").Cells(1, 1).Value))
        
            '#39442  ito 20171117　H30新仕様対応
            'Application.Run "DaAddin.xla!ProcLogging", ComAccount, PROC_NAME, "電子申請データ作成", vbNullString, guid, ThisWorkbook.Worksheets("登録").Cells(109, 2).Value, "成功"
            Application.Run "DaAddin.xla!ProcLogging", ComAccount, PROC_NAME, "電子申請データ作成", vbNullString, guid, ThisWorkbook.Worksheets("登録").Cells(110, 2).Value, "成功"
    
        End If
        '---------------------------------------------
        
'        If MsgBox("送信トレイに保存されました。作成したデータを電子申請しますか？", 1 + 32, "電子申請データ") <> 1 Then
'            Unload Me
'        Else
'            Unload Me
'            Application.Run "DaAddin.xla!OpenWorkbookActive", Workbooks("DaMenu.xls").path & "\DaProcess\電子申請.xls"
'        End If
        

'       #40150 SHIHO====================================================================================================

        Application.ScreenUpdating = True
    
        Dim eGovType As Long
    
        eGovType = Application.Run("EAppCom.xla!eGovModule.eGovApiFormShow", strPathName, ThisWorkbook.Worksheets("Data"), 0)
    
        If eGovType = 0 Then
            MsgBox "キャンセルされました。", vbInformation + vbOKOnly, "電子申請"
            Exit Sub
        End If
        
        Unload Me
                
        Call Application.Run("EAppCom.xla!eGovModule.ChangeNextDisplay", eGovType)
        
'       =================================================================================================================
End Sub
Sub XML編集()
    Dim d1      As Object
    Dim objITEM As Object
    Dim n As Long

     With Worksheets("登録")
        Set d1 = プレビュー.WebWindow.document
           For Each objITEM In プレビュー.WebWindow.document.all '本店支店
             If objITEM.tagName = "INPUT" Then
                 If objITEM.Name = "N70_CD" And objITEM.Checked = True Then
                     .Cells(106, 2).Value = objITEM.Value
                 End If
             End If
           Next
            .Cells(11, 2).Value = d1.Forms(0).Item("N3_HIHONO4").Value '被保険者番号/被保険者番号4桁
            .Cells(12, 2).Value = d1.Forms(0).Item("N4_HIHONO6").Value '被保険者番号/被保険者番号6桁
            .Cells(13, 2).Value = d1.Forms(0).Item("N5_HIHONOCD").Value '被保険者番号/被保険者番号CD
            
            .Cells(16, 2).Value = d1.Forms(0).Item("N6_NEN").Value '被保険者となった年月日/年
            .Cells(17, 2).Value = d1.Forms(0).Item("N7_TUKI").Value '被保険者となった年月日/月
            .Cells(18, 2).Value = d1.Forms(0).Item("N8_HI").Value '被保険者となった年月日/日
            .Cells(21, 2).Value = d1.Forms(0).Item("N9_HIHONO4").Value '事業所番号/事業所番号4桁
            .Cells(22, 2).Value = d1.Forms(0).Item("N10_JIGYOUNO6").Value '事業所番号/事業所番号6桁
            .Cells(23, 2).Value = d1.Forms(0).Item("N11_JIGYOUCD").Value '事業所番号/事業所番号CD
            .Cells(25, 2).Value = d1.Forms(0).Item("N12_KYUFUKINSU").Value '給付金の種類
            .Cells(29, 2).Value = d1.Forms(0).Item("N14_NEN").Value '賃金支払状況/賃金支払状況_支給対象月1/年
            .Cells(30, 2).Value = d1.Forms(0).Item("N15_TUKI").Value '賃金支払状況/賃金支払状況_支給対象月1/月
            .Cells(32, 2).Value = d1.Forms(0).Item("N16_SIKYUUKIN").Value '賃金支払状況/支給対象月に支払われた賃金額1
            .Cells(33, 2).Value = d1.Forms(0).Item("N17_GENGAKUHI").Value '賃金支払状況/賃金の減額のあった日数1
            .Cells(37, 2).Value = d1.Forms(0).Item("N20_NEN").Value '賃金支払状況/賃金支払状況_支給対象月2/年
            .Cells(38, 2).Value = d1.Forms(0).Item("N21_TUKI").Value '賃金支払状況/賃金支払状況_支給対象月2/月
            .Cells(40, 2).Value = d1.Forms(0).Item("N22_SIKYUUKIN").Value '賃金支払状況/支給対象月に支払われた賃金額2
            .Cells(41, 2).Value = d1.Forms(0).Item("N23_GENGAKUHI").Value '賃金支払状況/賃金の減額のあった日数2
            .Cells(45, 2).Value = d1.Forms(0).Item("N26_NEN").Value '賃金支払状況/賃金支払状況_支給対象月3/年
            .Cells(46, 2).Value = d1.Forms(0).Item("N27_TUKI").Value '賃金支払状況/賃金支払状況_支給対象月3/月
            .Cells(48, 2).Value = d1.Forms(0).Item("N28_SIKYUUKIN").Value '賃金支払状況/支給対象月に支払われた賃金額3
            .Cells(49, 2).Value = d1.Forms(0).Item("N29_GENGAKUHI").Value '賃金支払状況/賃金の減額のあった日数3
            .Cells(83, 2).Value = d1.Forms(0).Item("N52_TOKKIJIKOU").Value 'その他賃金に関する特記事項1
            .Cells(84, 2).Value = d1.Forms(0).Item("N53_TOKKIJIKOU").Value 'その他賃金に関する特記事項2
            .Cells(85, 2).Value = d1.Forms(0).Item("N54_TOKKIJIKOU").Value 'その他賃金に関する特記事項3
            .Cells(88, 2).Value = d1.Forms(0).Item("N56_NEN").Value '証明年月日/年
            .Cells(89, 2).Value = d1.Forms(0).Item("N57_TUKI").Value '証明年月日/月
            .Cells(90, 2).Value = d1.Forms(0).Item("N58_HI").Value '証明年月日/日
            .Cells(92, 2).Value = d1.Forms(0).Item("N59_JIGYOUSYOMEI").Value '事業所名_所在地
            .Cells(93, 2).Value = d1.Forms(0).Item("N60_JIGYOUSYUMEI").Value '事業主名
            .Cells(96, 2).Value = d1.Forms(0).Item("N62_NEN").Value '申請年月日/年
            .Cells(97, 2).Value = d1.Forms(0).Item("N63_TUKI").Value '申請年月日/月
            .Cells(98, 2).Value = d1.Forms(0).Item("N64_HI").Value '申請年月日/日
            .Cells(100, 2).Value = d1.Forms(0).Item("N65_ATESAKI").Value 'あて先
            .Cells(101, 2).Value = d1.Forms(0).Item("N66_FURIGANA").Value '申請者氏名_フリガナ
            .Cells(102, 2).Value = d1.Forms(0).Item("N67_SINSEISIMEI").Value '申請者氏名
            .Cells(104, 2).Value = d1.Forms(0).Item("N68_FURIGANA").Value '払渡希望金融機関/金融機関フリガナ
            .Cells(105, 2).Value = d1.Forms(0).Item("N69_MEISYOU").Value '払渡希望金融機関/金融機関名
            .Cells(107, 2).Value = d1.Forms(0).Item("N71_KINYUUCD").Value '払渡希望金融機関/金融機関コード
            .Cells(108, 2).Value = d1.Forms(0).Item("N72_TEMPOCD").Value '払渡希望金融機関/店舗コード
            .Cells(109, 2).Value = d1.Forms(0).Item("N73_KOUZANO").Value '払渡希望金融機関/預金通帳の口座番号
            .Cells(112, 2).Value = d1.Forms(0).Item("N74_BIKOUSINSEI").Value '備考
            .Cells(143, 2).Value = d1.Forms(0).Item("N93_SIMEI").Value '社会保険労務士記載欄/氏名
            .Cells(145, 2).Value = d1.Forms(0).Item("N94_SIGAI").Value '電話番号/市外局番
            .Cells(146, 2).Value = d1.Forms(0).Item("N95_SINAI").Value '電話番号/市内局番
            .Cells(147, 2).Value = d1.Forms(0).Item("N96_SINAI").Value '電話番号/加入者番号

        Set d1 = Nothing
    End With

    With Worksheets("証明")
        Set d1 = プレビュー.WebBrowser1.document
            .Cells(10, 2).Value = d1.Forms(0).Item("N1002_HIHOKENSYABANGOU4KETA").Value '被保険者番号/被保険者番号4桁
            .Cells(11, 2).Value = d1.Forms(0).Item("N1003_HIHOKENSYABANGOU6KETA").Value '被保険者番号/被保険者番号6桁
            .Cells(12, 2).Value = d1.Forms(0).Item("N1004_HIHOKENSYABANGOUCD").Value '被保険者番号/被保険者番号CD
            .Cells(15, 2).Value = d1.Forms(0).Item("N1005_JIGYOUSYABANGOU4KETA").Value '事業所番号/事業所番号4桁
            .Cells(16, 2).Value = d1.Forms(0).Item("N1006_JIGYOUSYABANGOU6KETA").Value '事業所番号/事業所番号6桁
            .Cells(17, 2).Value = d1.Forms(0).Item("N1007_JIGYOUSYABANGOUCD").Value '事業所番号/事業所番号CD
            .Cells(19, 2).Value = d1.Forms(0).Item("N1008_FURIGANA").Value 'フリガナ
            .Cells(20, 2).Value = d1.Forms(0).Item("N1009_ROKUJYUSAISHIMEI").Value '六十歳に達した者の氏名
            .Cells(22, 2).Value = d1.Forms(0).Item("N1010_MEISYOU").Value '事業所/名称
            .Cells(23, 2).Value = d1.Forms(0).Item("N1011_SYOZAICHI").Value '事業所/所在地
            .Cells(25, 2).Value = d1.Forms(0).Item("N1012_SHIGAIKYOKUBAN").Value '事業所/電話番号/市外局番
            .Cells(26, 2).Value = d1.Forms(0).Item("N1013_SHINAIKYOKUBAN").Value '事業所/電話番号/市内局番
            .Cells(27, 2).Value = d1.Forms(0).Item("N1014_KANYUSYABANGO").Value '事業所/電話番号/加入者番号
            .Cells(32, 2).Value = d1.Forms(0).Item("N1015_HAITATSUKYOKUBANGO").Value '六十歳に達した者の住所又は居所/郵便番号/配達局番号
            .Cells(33, 2).Value = d1.Forms(0).Item("N1016_CYOUIKIBANGO").Value '六十歳に達した者の住所又は居所/郵便番号/町域番号
            .Cells(35, 2).Value = d1.Forms(0).Item("N1017_JYUUSYO").Value '六十歳に達した者の住所又は居所/住所
            .Cells(37, 2).Value = d1.Forms(0).Item("N1018_SHIGAIKYOKUBAN").Value '六十歳に達した者の住所又は居所/電話番号/市外局番
            .Cells(38, 2).Value = d1.Forms(0).Item("N1019_SHINAIKYOKUBAN").Value '六十歳に達した者の住所又は居所/電話番号/市内局番
            .Cells(39, 2).Value = d1.Forms(0).Item("N1020_KANYUSYABANGO").Value '六十歳に達した者の住所又は居所/電話番号/加入者番号
            .Cells(43, 2).Value = d1.Forms(0).Item("N1021_WAREKI").Value '六十歳に達した日等の年月日/年号
            .Cells(44, 2).Value = d1.Forms(0).Item("N1022_NEN").Value '六十歳に達した日等の年月日/年
            .Cells(45, 2).Value = d1.Forms(0).Item("N1023_TSUKI").Value '六十歳に達した日等の年月日/月
            .Cells(46, 2).Value = d1.Forms(0).Item("N1024_HI").Value '六十歳に達した日等の年月日/日
            .Cells(49, 2).Value = d1.Forms(0).Item("N1025_WAREKI").Value '六十歳に達した日等の生年月日/年号
            .Cells(50, 2).Value = d1.Forms(0).Item("N1026_NEN").Value '六十歳に達した者の生年月日/年
            .Cells(51, 2).Value = d1.Forms(0).Item("N1027_TSUKI").Value '六十歳に達した者の生年月日/月
            .Cells(52, 2).Value = d1.Forms(0).Item("N1028_HI").Value '六十歳に達した者の生年月日/日
            .Cells(55, 2).Value = d1.Forms(0).Item("N1029_JYUUSYO").Value '事業主/住所
            .Cells(56, 2).Value = d1.Forms(0).Item("N1030_SHIMEI").Value '事業主/氏名
            .Cells(59, 2).Value = d1.Forms(0).Item("N1032_TSUKI").Value '六十歳に達した日等の翌日/月
            .Cells(60, 2).Value = d1.Forms(0).Item("N1033_HI").Value '六十歳に達した日等の翌日/日
            .Cells(64, 2).Value = d1.Forms(0).Item("N1034_TSUKI").Value '賃金支払状況等1/被保険者期間算定対象期間_前日/月
            .Cells(65, 2).Value = d1.Forms(0).Item("N1035_HI").Value '賃金支払状況等2/被保険者期間算定対象期間_前日/日
            .Cells(67, 2).Value = d1.Forms(0).Item("N1036_HIHOKENSYAKISONISSU").Value '賃金支払状況等1/被保険者期間算定対象期間_基礎日数
            .Cells(69, 2).Value = d1.Forms(0).Item("N1037_TSUKI").Value '賃金支払状況等1/賃金支払対象期間_前日/月
            .Cells(70, 2).Value = d1.Forms(0).Item("N1038_HI").Value '賃金支払状況等1/賃金支払対象期間_前日/日
            .Cells(72, 2).Value = d1.Forms(0).Item("N1039_CHINGINKISONISSU").Value '賃金支払状況等1/賃金支払対象期間_基礎日数
            .Cells(73, 2).Value = d1.Forms(0).Item("N1040_KASHIKINGAKUA").Value '賃金支払状況等1/賃金額A
            .Cells(74, 2).Value = d1.Forms(0).Item("N1041_KASHIKINGAKUB").Value '賃金支払状況等1/賃金額B
            .Cells(75, 2).Value = d1.Forms(0).Item("N1042_KASHIKINGAKUKEI").Value '賃金支払状況等1/賃金額計
            .Cells(76, 2).Value = d1.Forms(0).Item("N1043_BIKOU").Value '賃金支払状況等1/備考

            For n = 0 To 11
                .Cells(80 + 24 * n, 2).Value = d1.Forms(0).Item("N1044_TSUKI_" & n + 1).Value '被保険者期間算定対象期間_開始/月
                .Cells(81 + 24 * n, 2).Value = d1.Forms(0).Item("N1045_HI_" & n + 1).Value '被保険者期間算定対象期間_開始/日
                .Cells(84 + 24 * n, 2).Value = d1.Forms(0).Item("N1046_TSUKI_" & n + 1).Value '被保険者期間算定対象期間_終了/月
                .Cells(85 + 24 * n, 2).Value = d1.Forms(0).Item("N1047_HI_" & n + 1).Value '被保険者期間算定対象期間_終了/月
                .Cells(87 + 24 * n, 2).Value = d1.Forms(0).Item("N1048_HIHOKENSYAKISONISSU_" & n + 1).Value '被保険者期間算定対象期間_基礎日数
                .Cells(89 + 24 * n, 2).Value = d1.Forms(0).Item("N1049_TSUKI_" & n + 1).Value '賃金支払対象期間_開始/月
                .Cells(90 + 24 * n, 2).Value = d1.Forms(0).Item("N1050_HI_" & n + 1).Value '賃金支払対象期間_開始/日
                .Cells(93 + 24 * n, 2).Value = d1.Forms(0).Item("N1051_TSUKI_" & n + 1).Value '賃金支払対象期間_終了/月
                .Cells(94 + 24 * n, 2).Value = d1.Forms(0).Item("N1052_HI_" & n + 1).Value '賃金支払対象期間_終了/日
                .Cells(96 + 24 * n, 2).Value = d1.Forms(0).Item("N1053_CHINGINKISONISSU_" & n + 1).Value '賃金支払対象期間_基礎日数
                .Cells(97 + 24 * n, 2).Value = d1.Forms(0).Item("N1054_KASHIKINGAKUA_" & n + 1).Value '賃金額A
                .Cells(98 + 24 * n, 2).Value = d1.Forms(0).Item("N1055_KASHIKINGAKUB_" & n + 1).Value '賃金額B
                .Cells(99 + 24 * n, 2).Value = d1.Forms(0).Item("N1056_KASHIKINGAKUKEI_" & n + 1).Value '賃金額計
                .Cells(100 + 24 * n, 2).Value = d1.Forms(0).Item("N1057_BIKOU_" & n + 1).Value '備考
            Next
            .Cells(366, 2).Value = d1.Forms(0).Item("N1058_CHINGINTOKKIJIKOU").Value '賃金に関する特記事項
            .Cells(368, 2).Value = d1.Forms(0).Item("N1059_WAREKI").Value '受理年月日/年号
            .Cells(377, 2).Value = d1.Forms(0).Item("N1065_WAREKI").Value '社会保険労務士記載欄/作成年月日/年号
            .Cells(378, 2).Value = d1.Forms(0).Item("N1066_NEN").Value '社会保険労務士記載欄/作成年月日/年
            .Cells(379, 2).Value = d1.Forms(0).Item("N1067_TSUKI").Value '社会保険労務士記載欄/作成年月日/月
            .Cells(380, 2).Value = d1.Forms(0).Item("N1068_HI").Value '社会保険労務士記載欄/作成年月日/日
            .Cells(382, 2).Value = d1.Forms(0).Item("N1069_TEISYUTSUDAIKOUSYA").Value '社会保険労務士記載欄/提出代行者_事務代理者の表示
            .Cells(383, 2).Value = d1.Forms(0).Item("N1070_SHIMEI").Value '社会保険労務士記載欄/氏名
            .Cells(385, 2).Value = d1.Forms(0).Item("N1071_SHIGAIKYOKUBAN").Value '社会保険労務士記載欄/電話番号/市外局番
            .Cells(386, 2).Value = d1.Forms(0).Item("N1072_SHINAIKYOKUBAN").Value '社会保険労務士記載欄/電話番号/市内局番
            .Cells(387, 2).Value = d1.Forms(0).Item("N1073_KANYUSYABANGO").Value '社会保険労務士記載欄/電話番号/加入者番号
            .Cells(389, 2).Value = d1.Forms(0).Item("N1074_FUKIRAN").Value '備考
                    
            Application.Calculation = xlAutomatic
        
        Set d1 = Nothing
    End With
End Sub
Function 添付Check() As Boolean

        Dim ファイル名  As String
        Dim FileName    As String
        Dim i           As Integer
        
'      提出代行の存在チェック（20100913masa 提出代行なしに対応）
        If TextBox5.Value = "" And OptionButton3.Value = False Then
            MsgBox "提出代行証明書が未設定です。", 16, "提出代行"
            添付Check = False
            Exit Function
        End If
        If Dir(TextBox5.Value) = "" And OptionButton3.Value = False Then '存在するかチェック'20100913masa 提出代行なしに対応
            MsgBox "提出代行証明書のファイルが存在しません。", 16, AAA
            添付Check = False
            Exit Function
        End If
        
'　　　　本人同意書
        If TextBox100.Value = "" Then
            MsgBox "本人の同意書が設定されていません。", 16, AAA
            Exit Function
            Else
            Worksheets("DATA").Cells(11, 2).Value = TextBox100.Value
        End If

'#37486 ishikawa 20171114 api対応
        '添付ファイル名の半角文字、機種依存文字チェック
'        If FileNameCheck(TextBox100.Value) = False Then
'            MsgBox "添付ファイル名に半角文字、機種依存文字が含まれています。", 16, "本人同意書"
'            添付Check = False
'            Exit Function
'        End If
'        If FileNameCheck(TextBox5.Value) = False And OptionButton3.Value = False Then
'            MsgBox "添付ファイル名に半角文字、機種依存文字が含まれています。", 16, "提出代行"
'            添付Check = False
'            Exit Function
'        End If
'
'        With ThisWorkbook.Worksheets("DATA")
'            For i = 64 To 68
'                If FileNameCheck(.Cells(i, 4).Value) = False Then
'                    MsgBox "添付ファイル名に半角文字、機種依存文字が含まれています。", 16, "添付ファイル"
'                    添付Check = False
'                    Exit Function
'                End If
'            Next
'        End With
'#37486 ここまで
        
        添付Check = True
        
End Function


Attribute VB_Name = "Sheet4"
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 = "Sheet7"
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 = "Sheet8"
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 = "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 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
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 MojiCheck(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
            Else
                If Asc(strg1) < 43 Or (Asc(strg1) > 46 And Asc(strg1) < 47) Or (Asc(strg1) > 48 And Asc(strg1) < 64) Or (Asc(strg1) > 94 And Asc(strg1) < 96) Or Asc(strg1) > 123 Then
                    n = n + 1
                End If
            End If
        Next
        
    If n = 0 Then
        MojiCheck = ""
    Else
        MojiCheck = "??"
    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 = "Module1"
'’修正履歴　------------------------------------------------------------------
            'YBNO 31594  ito 20160502　シート名置換（登録2→登録、証明2→証明）
'’----------------------------------------------------------------------------

Option Explicit
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 PROC_NAME As String = "高年齢雇用継続給付"  'YBNO 31594  ito 20160506　追加

''' YBNO18160 シート[証明]
''' R74C2 OR句を作った
''' END YBNO 18160
Sub 初期処理()
    Dim ファイル名   As String
    Dim TextFilename As String
    Dim MyStr        As String
    Dim FileName     As String
    Dim n            As Integer
    Dim i            As Integer
        
    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"
        '### 23803
        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(12, 2).Value = Replace(GetTextData(16, .Cells(2, 2).Value), """", vbNullString)
        .Cells(13, 2).Value = Replace(GetTextData(24, .Cells(2, 2).Value), """", vbNullString)
        'END#2465 20120702

'        '提出代行パス
        .Cells(3, 2).Value = GetTextData(1, FileName)
        .Cells(4, 2).Value = GetTextData(2, FileName)
        .Cells(5, 2).Value = GetTextData(3, FileName)
        
        
        '提出先コードと名称
        .Cells(9, 2).Value = GetTextData(25, FileName)
        
        '#40067/40288  ito 20180302
        ''20110125 masa コードを取得
        ''.Cells(8, 2).Value = GetTextData(24, filename)
        'Application.Calculation = xlCalculationManual
        '    Workbooks.Open ThisWorkbook.path & "\提出先一覧.xls"
        '        For i = 1 To Cells(1005, 7).End(xlUp).Row
        '            If .Cells(9, 2).Value = Cells(i, 7).Value Then
        '                .Cells(8, 2).Value = Cells(i, 6).Value
        '                Exit For
        '            End If
        '        Next
        '    Workbooks("提出先一覧.xls").Close False
        'Application.Calculation = xlCalculationAutomatic
        .Cells(8, 2).Value = GetTextData(24, FileName)
        
        '添付ファイルクリア
        '#37486  ito 20171115　同意書まで範囲拡張
        '.Range(.Cells(61, 2), .Cells(68, 2)).ClearContents
        '.Range(.Cells(61, 4), .Cells(68, 4)).ClearContents
        .Range(.Cells(61, 2), .Cells(73, 2)).ClearContents
        .Range(.Cells(61, 4), .Cells(73, 4)).ClearContents

    End With
    
    Call チェック("登録")
    Call チェック("証明")
    
    Call XML作成("登録", ThisWorkbook.Worksheets("DATA").Cells(82, 2).Value)
    Call XML作成("証明", ThisWorkbook.Worksheets("DATA").Cells(97, 2).Value)
    
    Worksheets("MENU").Select
    Application.ScreenUpdating = True
    プレビュー.Show
    'マスター.Show

End Sub
'Sub マスターへ()
'    マスター.Show
'End Sub
Sub 終了へ()
    Application.Run "DaAddin.xla!閉じる"

End Sub
Sub プレビューへ()
    
    プレビュー.Show
    
End Sub
Sub XML作成(sh As String, sh1 As String)
    Dim f1 As New TextFile
    Dim f2 As New TextFile
    Dim f3 As New TextFile
    
    Application.DisplayAlerts = (False)        'メッセージ非表示
    
    f1.FileCreate ThisWorkbook.path & "\スタイルシート\" & sh1 & "_01.xml", "UTF-8"
    Body f1, sh
    f1.FileClose
    Application.DisplayAlerts = (True)        'メッセージ非表示
    
    
End Sub

Sub チェック(sh As String) 'XMLシートのエラーチェック
    Dim i As Integer
    Dim n As Integer
    
    Application.Calculation = xlManual

    With ThisWorkbook.Worksheets(sh)
        For i = 10 To .Cells(3005, 1).End(xlUp).Row
            If .Cells(i, 20).Value = "??" Or .Cells(i, 26).Value = "??" Or .Cells(i, 28).Value = "??" Or .Cells(i, 42).Value = "??" Then
            MsgBox .Cells(i, 23).Value & "のデータが不正です。", 16, AAA
            Application.Calculation = xlAutomatic
            ThisWorkbook.Close False
            End If
        Next
    End With
    
    Application.Calculation = xlAutomatic
 
End Sub
Public Function SetTelNumber(ByVal str As String, ByVal no As Long) As String

    If Len(str) - Len(Replace(str, "-", "")) = 2 Then
        SetTelNumber = Split(str, "-")(no - 1)
    Else
        SetTelNumber = vbNullString
    End If

End Function
Public Sub SelectAttachFile(ByVal TextString As String)

    ShellExecute 0, "Open", TextString, "", "", 5

End Sub


'#33718  ito 20161004　追加
Sub manual()
    Dim url As String
    url = "https://www.cells.co.jp/daityo-s/wp-content/uploads/manual/koyoukeizoku.pdf"
    Application.Run "DaAddin.xla!WebManual", url
End Sub

Attribute VB_Name = "TextFile"
Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False

' TextFile:
' VBA class module for creating UTF-8 textfiles
'
' Usage:
' Dim fd As New TextFile
' fd.FileCreate "c:\any\path\to\the\textfile", "UTF-8"
' fd.TextWrite "any text"
' fd.TextWriteLine "any text line"
' fd.FileClose
'
…

Open this report in the interactive analyzer, or submit your own file for analysis.