Malicious Office (OLE) — malware analysis report

Static analysis result for SHA-256 a596914b735ed8cb…

MALICIOUS

Office (OLE)

650.0 KB Created: 2009-11-26 07:15:28 Authoring application: Microsoft Excel First seen: 2018-06-21
MD5: 31c90c4ef5dec12ebed7baacdb270f7c SHA-1: ca73af81c095f7623485791e2fce1753516401a7 SHA-256: a596914b735ed8cbb4672fd073af137dbc8d7b1e559b7642df66325e99f180be
518 Risk Score

Malware Insights

MITRE ATT&CK
T1059.005 Visual Basic T1204.002 Malicious File T1105 Ingress Tool Transfer

The sample is an Excel document containing obfuscated VBA macros. The Workbook_Open macro attempts to execute external code, likely downloading and running a second-stage payload. Heuristics indicate the use of CreateProcess, ShellExecute, WScript.Shell, and a potential LOLBin reference, all pointing towards malicious execution. The document body contains fields related to electronic application submissions, suggesting a lure to trick users into enabling macros.

Heuristics 14

  • VBA macros detected medium 8 related findings OLE_VBA_MACROS
    Document contains VBA macro code
  • Potential Shell call in VBA critical OLE_VBA_SHELL
    Potential Shell call in VBA
    Matched line in script
        Shell str, vbNormalFocus
  • WScript.Shell usage critical OLE_VBA_WSCRIPT
    WScript.Shell usage
    Matched line in script
            Dim exeret As Long
        With CreateObject("Wscript.Shell")
        On Error GoTo exeRunError
  • LOLBin reference in VBA critical OLE_VBA_LOLBIN
    LOLBin reference in VBA
    Matched line in script
    '        .lpVerb = "runas"
'        .lpFile = Interaction.Environ("SYSTEMROOT") & "\System32\msiexec.exe"
'        .lpParameters = "/qn /x {" & strPram & "}"
  • Obfuscated auto-exec VBA loader critical OLE_VBA_OBFUSCATED_AUTOEXEC_LOADER
    Auto-exec VBA reconstructs strings with a heavy custom decoder (numeric char-array, repeated hex-string decode, or junk-token Replace removal) and feeds them to a COM-instantiation or execution sink. This obfuscated-loader shape keeps CreateObject/Shell/URL indicators out of the macro source.
    Matched line in script
    Option Explicit
Private Declare Function ShellExecute Lib "shell32.dll" _
    Alias "ShellExecuteA" ( _
  • CreateObject call high OLE_VBA_CREATEOBJ
    CreateObject call
    Matched line in script
    '
'    Set fso = CreateObject("Scripting.FileSystemObject")
'
  • VBA p-code auto-exec with execution tokens high OLE_VBA_PCODE_AUTOEXEC_EXEC
    Compiled VBA/cache stream contains an auto-execution token together with shell/download/object-execution tokens. This catches p-code-only or source-extraction-failure macro documents where visible source is unavailable.
  • Workbook_Open macro low OLE_VBA_WBOPEN
    Workbook_Open macro
    Matched line in script
    Private Const ERROR_FILE_NOT_FOUND = 2
Private Sub Workbook_Open()
  • Environ() call (env variable access) low OLE_VBA_ENVIRON
    Environ() call (env variable access)
    Matched line in script
    '
'    FileName = PathCombine(VBA.Interaction.Environ("ProgramFiles"), SIGN_EXE_PATH)
'
  • Reference to CreateProcess API high SC_STR_CREATEPROCESS
    Reference to CreateProcess API
  • Reference to ShellExecute API high SC_STR_SHELLEXEC
    Reference to ShellExecute API
  • Reference to Windows Script Host high SC_STR_WSCRIPT
    Reference to Windows Script Host
  • Clipboard command execution lure high SE_CLIPBOARD_COMMAND_LURE
    Document tells the user to copy or paste clipboard content into Run, PowerShell, cmd, or another shell-like execution context
  • 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 http://plus-samurai.jp/daityo/wp-content/uploads/sinseigo.pdf In document text (OLE body)
    • https://shinsei2.kn.e-gov.go.jp/Shinsei/main.jsp�In document text (OLE body)
    • https://shinsei.e-gov.go.jp/Shinsei/main.jsp�In document text (OLE body)
    • https://shinsei.e-gov.go.jp/Shinsei/main.jsp?egovparam=PK011K0001In document text (OLE body)
    • https://api.cells.jp/OfficelDocArcvService.svc/exist�In document text (OLE body)
    • https://api.cells.jp/OfficelDocArcvService.svc/uploadIn document text (OLE body)
    • https://api.cells.jp/OfficelDocArcvService.svc/removeIn document text (OLE body)
    • https://api.cells.jp/OfficelDocArcvService.svc/chatworkIn document text (OLE body)
    • https://shinsei2.kn.e-gov.go.jp/Shinsei/main.jspIn document text (OLE body)
    • https://www.cells.co.jp/daityo-s/wp-content/uploads/manual/srmypagedocupload.pdfAIn document text (OLE body)
    • https://www.cells.co.jp/daityo-s/wp-content/uploads/manual/kbntorikomi.pdfAIn document text (OLE body)
    • https://shinsei.e-gov.go.jp/Shinsei/main.jspIn document text (OLE body)
    • https://api.cells.jp/OfficelDocArcvService.svc/existIn document text (OLE body)
    • https://www.cells.co.jp/daityo-s/wp-content/uploads/manual/srmypagedocupload.pdfIn document text (OLE body)
    • https://www.cells.co.jp/daityo-s/wp-content/uploads/manual/kbntorikomi.pdfIn 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) 704458 bytes
SHA-256: 3e2b17fc3af082619872e8138a6e229fb4738bd14eaf05e764c148314fe79cc7
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 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
'ShellExecuteEXで使用する構造体
Private Type SHELLEXECUTEINFO
    cbSize As Long
    fMask As Long
    hWnd As Long
    lpVerb As String
    lpFile As String
    lpParameters As String
    lpDirectory As String
    nShow As Long
    hInstApp As Long
    lpIDList As Long
    lpClass As String
    hkeyClass As Long
    dwHotKey As Long
    hIcon As Long
    hProcess As Long
End Type
'WaitForSingleObject
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function ShellExecuteEX Lib "shell32.dll" Alias "ShellExecuteEx" (SEI As SHELLEXECUTEINFO) As Long
'WaitForSingleObjectで使用する定数
Private Const INFINITE = &HFFFF ' Infinite timeout
'ShellExecuteEXで使用する定数
Private Const SEE_MASK_NOCLOSEPROCESS = &H40

Private Const SW_SHOWNORMAL = 1
Private Const SE_ERR_NOASSOC = 31
Private Const ERROR_FILE_NOT_FOUND = 2
Private Sub Workbook_Open()

    Dim strbuffer As String
    Dim nRet As Long
    Dim msg As String

    If Application.Run("EAppCom.xla!IsInstallEgovDll") Then
        If MsgBox("最新の一括申請ツールをインストールします。よろしいですか？", vbQuestion + vbOKCancel, "電子申請") = vbOK Then
            'インストール
            Application.Run "EAppCom.xla!InstallEgovDll"
        Else
            '閉じる
            msg = "処理を中止します。お手数ですが、台帳メニューの[ツール]-[4. 一括申請ツールのインストール]より最新版をインストールしてください。"
            MsgBox msg, vbInformation + vbOKOnly, "電子申請"
            ThisWorkbook.Close False
            Exit Sub
        End If
    End If

    'レジストリに台帳パスを埋める(送信番号取得のため)
    strbuffer = Replace(ThisWorkbook.path, "\DaProcess", "")
    strbuffer = Replace(strbuffer, "\", "\\")

    nRet = XXX_SetRegistryString(HKEY_CURRENT_USER, "software\cells\daityo", "path", strbuffer)

    Dim strURL As String

    'If Range("K26").Value <> 1 Then
        XXX_SetRegistryString HKEY_CURRENT_USER, "software\cells\daityo", "url", LOGIN_URL
    'Else
        'XXX_SetRegistryString HKEY_CURRENT_USER, "software\cells\daityo", "url", TEST_URL
    'End If
    
    '''YBNO21642
    Application.Run "EAppCom.xla!TetsuzukiDB"
    '''END 21642

    #If DEBUG_MODE Then
        '1なら画面にテストモードと表示する
        Sheets("MENU").Unprotect
        Cells(6, 1).value = "テストモード"
        Sheets("MENU").Protect
    #Else
        Sheets("MENU").Unprotect
        Cells(6, 1).Clear
        Sheets("MENU").Protect
    #End If

    SearchSQL = vbNullString

    '画面にバージョンを表記する
    Sheets("MENU").Unprotect
    Cells(27, 2).value = Application.Run("EAppCom.xla!GetEGovDLLFileVersion")
    Sheets("MENU").Protect

    CheckDbVersion

End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

    MsgBox "このファイルは保存できません。", vbCritical + vbOKOnly, "保存不可"
    Cancel = True
    
End Sub

'Private Function IsSansyo() As Boolean
'
'    Dim Ref As Variant
'
'    For Each Ref In ActiveWorkbook.VBProject.References
'        If Ref.isbroken And Ref.GUID = "{05D7A42E-73F8-4A87-AF3F-8AAEF91CF810}" Then
'            IsSansyo = False
'            Exit Function
'        End If
'    Next Ref
'
'    IsSansyo = True
'
'End Function
'Private Function IsToolsDate(ByRef msg As String) As Boolean
'
'    Dim ret As Boolean
'    Dim fso As Object
'    Dim FileName As String
'    Dim objFile As Object
'    Dim MSGString As String
'
'    MSGString = "お手数ですが、台帳メニューの[ツール]-[4. 一括申請ツールのインストール]より最新版をインストールしてください。"
'
'    ret = False
'
'    Set fso = CreateObject("Scripting.FileSystemObject")
'
'    FileName = PathCombine(VBA.Interaction.Environ("ProgramFiles"), SIGN_EXE_PATH)
'
'    If IsExist(FileName, False) Then
'        Set objFile = fso.GetFile(FileName)
'        'ツールが古い
'        If CDate(objFile.DateCreated) > #1/1/2014 11:00:00 AM# Then
'            ret = True
'        Else
'            msg = "電子申請ツールが最新ではありません。" & vbCrLf & MSGString
'            ret = False
'        End If
'        Set objFile = Nothing
'    Else
'        msg = "電子申請ツールがインストールされていません。" & vbCrLf & MSGString
'    End If
'
'    Set fso = Nothing
'
'    IsToolsDate = ret
'
'End Function
'Private Sub 電子申請一括ツール()
'
'    Dim ret     As Long
'    Dim str     As String
'
'    'MsgBox ToolVersion(VBA.Strings.Trim(Workbooks("DaMenu.xls").path) & "\台帳電子申請ツール.msi")
'
''    UninstallProc "7A6A1A67-9EFB-4185-8BA2-2734A5A29691"
''    UninstallProc "6AA34833-9FA5-499B-8D61-E139D7084EBF" '1.90.38のアンインストール
''    UninstallProc "ACA9BBC5-872A-48EB-90BE-6ACE7DD095C0" '2.00.03のアンインストール
''    UninstallProc "611F478F-F48B-447B-9B92-C5669C0C1AEB" '2.00.31のアンインストール
'
'    'UninstallProc "AC0A53F6-FCBA-453E-A939-D432DE0A2AEA" '2.00.37のアンインストール
'
'    ret = InstallProc(VBA.Strings.Trim(Workbooks("DaMenu.xls").path) & "\setup.exe")
'
'    Select Case ret
'        Case SE_ERR_NOASSOC
'            MsgBox "一括申請ツールのインストールに失敗しました。", vbInformation, "一括申請ツール"
'        Case ERROR_FILE_NOT_FOUND
'            MsgBox "一括申請ツールのインストールが見つかりません。", vbInformation, "一括申請ツール"
'    End Select
'
'End Sub
'Private Function ToolVersion(ByVal fname As String) As String
'
'    ' msiファイルを開く
'    Const msiOpenDatabaseModeReadOnly = 0 '読取専用モード
'
'    Dim installer As Object
'    Set installer = CreateObject("WindowsInstaller.Installer")
'    Dim database  As Object
'    Set database = installer.OpenDatabase(fname, msiOpenDatabaseModeReadOnly)
'
'    ToolVersion = GetPropertyValue(database, "ProductVersion")
'
'    database.Commit
'    Set database = Nothing
'    Set installer = Nothing
'
'End Function
'Private Function GetPropertyValue(ByRef database As Object, ByVal propertyName As String)
'
'  Dim query As String
'   Dim view As Object
'    Dim record As Object
'  Dim value As String
'
'   query = "SELECT Value FROM Property WHERE Property='" & propertyName & "'"
'  Set view = database.OpenView(query)
' view.Execute
'    Set record = view.Fetch
' value = record.StringData(1)
'    GetPropertyValue = value
'
'    Set record = Nothing
'    Set view = Nothing
'
'End Function
'Private Sub UninstallProc(ByVal strPram As String)
'
'    Dim ret     As Long
'    Dim sdtSEXI As SHELLEXECUTEINFO
'
'    With sdtSEXI
'        .cbSize = Len(sdtSEXI)
'        .fMask = SEE_MASK_NOCLOSEPROCESS
'        .hwnd = Application.hwnd
'        .lpVerb = "runas"
'        .lpFile = Interaction.Environ("SYSTEMROOT") & "\System32\msiexec.exe"
'        .lpParameters = "/qn /x {" & strPram & "}"
'        .lpDirectory = vbNullChar
'        .nShow = SW_SHOWNORMAL
'        .hInstApp = 0
'        .lpIDList = 0
'    End With
'
'    ret = ShellExecuteEX(sdtSEXI)
'    ret = WaitForSingleObject(sdtSEXI.hProcess, INFINITE)
'
'End Sub
'Private Function InstallProc(ByVal strFilePath As String) As Long
'
'    Dim ret     As Long
'    Dim sdtSEXI As SHELLEXECUTEINFO
'
'    With sdtSEXI
'        .cbSize = Len(sdtSEXI)
'        .fMask = SEE_MASK_NOCLOSEPROCESS
'        .hwnd = Application.hwnd
'        .lpVerb = "runas"
'        .lpFile = strFilePath
'        .lpParameters = "/qn"
'        .lpDirectory = vbNullChar
'        .nShow = SW_SHOWNORMAL
'        .hInstApp = 0
'        .lpIDList = 0
'    End With
'
'    ret = ShellExecuteEX(sdtSEXI)
'    ret = WaitForSingleObject(sdtSEXI.hProcess, INFINITE)
'
'End Function

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

Attribute VB_Name = "frmSearch"
Attribute VB_Base = "0{591B3A43-E1F0-43F1-8F52-BD0ECAE2AB0A}{C1C74E68-74BB-4097-8265-40D6EED2FC2C}"
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 dbCon As New ADODB.Connection
Private dbRes As New ADODB.Recordset
Private Sub cmdSearch_Click()

'20140425 kon 25093
    If optNearly.value = True Then
        If txtNearDay.Text = "" Then
            MsgBox "直近データで検索する場合は、日数を入力してください。", vbInformation, "送信済リスト"
            Exit Sub
        End If
        '20140410 kon 24776
        If txtNearDay.Text >= 60 Then
            MsgBox "直近データは、60日未満で入力してください。", vbInformation, "送信済リスト"
            Exit Sub
        End If
        
    End If
    InitList

    Unload Me

End Sub
Private Sub UserForm_Initialize()

   'データベース変数初期化
   InitDBObject DB_PATH, dbCon

   InitDisp

End Sub
Private Sub UserForm_Terminate()
    
    Dim nRet As Integer
    
    nRet = XXX_SetRegistryString(HKEY_CURRENT_USER, "software\cells\daityo", "DisplayDay", txtNearDay.Text)
    
    Set dbRes = Nothing

End Sub
Private Sub InitDisp()
    
    Dim i As Long
    
    '会社情報リストボックス
    cboCompany.Clear
    cboCompany.AddItem "すべて"
    
    
    ' レコードセットを取得
    'dbRes.Open "SELECT distinct 会社名 FROM 申請データ", dbCon, adOpenForwardOnly, adLockReadOnly
    dbRes.Open "SELECT distinct 会社名, ASC(会社名) FROM 申請データ", dbCon, adOpenForwardOnly, adLockReadOnly '#30507
    Do Until dbRes.EOF
        '非表示
        cboCompany.AddItem dbRes("会社名")
        dbRes.MoveNext
    Loop

    cboCompany.ListIndex = 0

    ' レコードセット、データベースを閉じる
    dbRes.Close
    
    '手続き情報リストボックス
    cboTetuzuki.Clear
    cboTetuzuki.AddItem "すべて"
    
    '種類ボックス
    Me.cboSyu.Clear
    cboSyu.AddItem "すべて"
    cboSyu.AddItem "社"
    cboSyu.AddItem "雇"
    cboSyu.AddItem "労"
    cboSyu.ListIndex = 0
        
    ' レコードセットを取得
    dbRes.Open "SELECT distinct 手続名 FROM 申請データ", dbCon, adOpenForwardOnly, adLockReadOnly
    
    Do Until dbRes.EOF
        '非表示
        cboTetuzuki.AddItem dbRes("手続名")
        dbRes.MoveNext
    Loop

    cboTetuzuki.ListIndex = 0

    ' レコードセット、データベースを閉じる
    dbRes.Close
    
    
'YBNO 25532  ito 20150320　申請先追加　------------------------------------------------------
    '申請先情報リストボックス
    cobSaki.Clear
    cobSaki.AddItem "すべて"
    
    ' レコードセットを取得
    dbRes.Open "SELECT distinct 申請先 FROM 申請データ", dbCon, adOpenForwardOnly, adLockReadOnly
     
    Do Until dbRes.EOF
        '非表示
        cobSaki.AddItem dbRes("申請先")
        dbRes.MoveNext
    Loop

    cobSaki.ListIndex = 0

    ' レコードセット、データベースを閉じる
    dbRes.Close
'YBNO 25532  ito 20150320　ここまで　------------------------------------------------------
    

    '年月ボックスの中身
    Me.cboYear.Clear
    
    'YB 29808 20160105 fuku
'    For i = 2010 To 2015
    For i = 2010 To Year(Now())
        cboYear.AddItem i
    Next i
    cboYear.ListIndex = Year(Now()) - 2010
    
    Me.cboMonth.Clear
    For i = 1 To 12
        cboMonth.AddItem i
    Next i
    cboMonth.ListIndex = Month(Now()) - 1
    
    '直近n日を取得する
     '何日分表示するか取得する
    Dim nRet As Integer
    Dim mDay As String
    
    nRet = XXX_GetRegistryString(HKEY_CURRENT_USER, "software\cells\daityo", "DisplayDay", mDay)
       
    If IsNumeric(mDay) Then
        '1以上60以下使う
        If CInt(mDay) >= 1 And CInt(mDay) <= 60 Then
            txtNearDay.Text = mDay
        Else
            txtNearDay.Text = 14
            nRet = XXX_SetRegistryString(HKEY_CURRENT_USER, "software\cells\daityo", "DisplayDay", txtNearDay.Text)
        End If
    Else
        '数字でない場合は、14日(2週)分
        txtNearDay.Text = 14
        nRet = XXX_SetRegistryString(HKEY_CURRENT_USER, "software\cells\daityo", "DisplayDay", txtNearDay.Text)
    End If

    Me.cboJyokyo.Clear
    cboJyokyo.AddItem ""
    cboJyokyo.AddItem "申請"
    cboJyokyo.AddItem "到達"
    cboJyokyo.AddItem "審査中"
    cboJyokyo.AddItem "審査終了"
    cboJyokyo.AddItem "手続終了"
    cboJyokyo.AddItem "複数"
    cboJyokyo.AddItem "エラー"
    
    cboJyokyo.ListIndex = 0

End Sub
Private Sub InitList()

    Dim strSQL As String

    strSQL = "SELECT id,作成日,申請番号,申請先,会社名,社or雇or労,手続名,内容,到達番号,"
    strSQL = strSQL & "SWITCH(状況 = 1,'申請',状況 = 2,'到達',状況 = 3,'審査中',状況 = 4,'審査終了',状況 = 5,'手続終了',状況 = 6,'複数',"
    strSQL = strSQL & "状況 = 7 AND LEFT(申請番号,14) < '" & Format(DateAdd("n", -5, Now), "YYYYMMDDHHmmss") & "','エラー')"
    '#35578 nr 2017/02/13 s
'    strSQL = strSQL & ",フォルダ名,その他1,その他2,その他3,担当,返戻フラグ FROM 申請データ WHERE (状況 <> 0 AND 状況 <> 99) "
    strSQL = strSQL & ",フォルダ名,その他1,その他2,その他3,担当,返戻フラグ,公文書処理日,公文書アップロード日  FROM 申請データ WHERE (状況 <> 0 AND 状況 <> 99) "
    '#35578 nr 2017/02/13 e

    If Trim(txt001.Text) <> vbNullString Then
        strSQL = strSQL & " AND 申請番号 = """ & txt001.Text & """"
    End If
    If Trim(txt002.Text) <> vbNullString Then
        strSQL = strSQL & " AND 到達番号 = """ & txt002.Text & """"
    End If
    If cboSyu.ListIndex <> 0 Then
        strSQL = strSQL & "AND 社or雇or労 = """ & cboSyu.List(cboSyu.ListIndex) & """"
    End If
    If cboTetuzuki.ListIndex <> 0 Then
        strSQL = strSQL & "AND 手続名 = """ & cboTetuzuki.List(cboTetuzuki.ListIndex) & """"
    End If
    ''' # 25189
    If cboCompany.ListIndex <> 0 Then
        'strSQL = strSQL & " AND 会社名 like ""%" & cboCompany.List(cboCompany.ListIndex) & "%"""
        'YBNO 31687  ito 20160517
        'strSQL = strSQL & " AND InStr(1,会社名,""" & cboCompany.List(cboCompany.ListIndex) & """,0)" '#30507
        strSQL = strSQL & " AND StrComp(会社名,""" & cboCompany.List(cboCompany.ListIndex) & """,0) = 0"
    End If
'    If Trim(txt004.Text) <> vbNullString Then
'        strSQL = strSQL & " AND 会社名 like ""%" & txt004.Text & "%"""
'    End If
''' End 25189
    If Trim(txt005.Text) <> vbNullString Then
        strSQL = strSQL & " AND FD通番 = """ & txt005.Text & """"
    End If
    If Trim(txt006.Text) <> vbNullString Then
        strSQL = strSQL & " AND 担当 = """ & txt006.Text & """"
    End If
    If Trim(txt007.Text) <> vbNullString Then
        strSQL = strSQL & " AND その他1 like  ""%" & txt007.Text & "%"""
    End If
    If Trim(txt008.Text) <> vbNullString Then
        strSQL = strSQL & " AND その他2 like ""%" & txt008.Text & "%"""
    End If
    If Trim(txt009.Text) <> vbNullString Then
        strSQL = strSQL & " AND その他3 like ""%" & txt009.Text & "%"""
    End If
    If Me.cboJyokyo.ListIndex <> 0 Then
        strSQL = strSQL & " AND 状況 = " & Me.cboJyokyo.ListIndex
    End If
    
    'YBNO 25532  ito 20150320　提出先追加
    If cobSaki.ListIndex <> 0 Then
        strSQL = strSQL & "AND 申請先 = """ & cobSaki.List(cobSaki.ListIndex) & """"
    End If
    
    If Me.optNearly.value Then
'20120301 kon #14048
'        strSQL = strSQL & "AND id > """ & Format(DateAdd("d", -14, Now), "yyyymmdd") & String(9, "0") & """"
'        strSQL = strSQL & "AND id > """ & Format(DateAdd("m", -1, Now), "yyyymmdd") & String(9, "0") & """"
'何日分表示するか取得する
            Dim nRet As Integer
            Dim mDay As String
            
            'nRet = XXX_GetRegistryString(HKEY_CURRENT_USER, "software\cells\daityo", "DisplayDay", mDay)
            
            If IsNumeric(Me.txtNearDay.Text) Then
                '1以上60以下使う
                If CInt(Me.txtNearDay.Text) < 1 Or CInt(Me.txtNearDay.Text) > 60 Then
                    Me.txtNearDay.Text = "14"
                End If
            Else
                '数字でない場合は、14日(2週)分
                Me.txtNearDay.Text = "14"
            End If
            strSQL = strSQL & "AND id > """ & Format(DateAdd("d", CInt(Me.txtNearDay.Text) * -1, Now), "yyyymmdd") & String(9, "0") & """"
            nRet = XXX_SetRegistryString(HKEY_CURRENT_USER, "software\cells\daityo", "DisplayDay", Me.txtNearDay.Text)
    ElseIf Me.opHere Then
        strSQL = strSQL & " AND id BETWEEN '" & cboYear & Format(cboMonth, "00") & "000000000000' AND '" & cboYear & Format(cboMonth, "00") & "999999999999'"
    End If

    strSQL = strSQL & " ORDER BY id DESC"

    SearchSQL = strSQL
    
    'frm申請済リスト.InitList strSQL
    申請済リスト SearchSQL

End Sub

Attribute VB_Name = "frmProgress"
Attribute VB_Base = "0{911D3806-E13B-4D1F-B1BC-FC2354DF090F}{7B8AAAB5-17AE-4ED5-A950-E8EAED285142}"
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


Attribute VB_Name = "Module1"
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'公文書取得ボタンの表示は
'フォルダの表示を右クリック→キーボードのコントロールキーをクリック

'修正履歴
'27293 控シートの会社名が入るセルの書式設定を変更 20150325 hara
'30055 Q&A機能の追加 20160126 hara
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit
Public Const aaa As String = "e-Gov 一括電子申請"
'taka 20160927 kbn
Public fNam As String
Public KozinRow As Variant
Public DouseiRow As Variant
Public CsvPath As String
Public CsvFile As String
Public ClseHantei As Long
Public DsiHantei As Long
Public KsiHantei As Long
Public NotHantei As Long
Public tmp As Variant
Public KbnPath As String
Public SKHantei As String
Public XmlPath As Variant
Public KbnXml As String
Public ErseCh As Long
Public LogDaName As String  '#40033  ito 20180125　追加　ログ用da名
'Public MyNoPresence As Long  '#37887  ito 20170627　追加　xmlの個人番号の有無判定（電子申請.xls内でのみ使用（介護休業給付用　0：なし　1：家族有　2：本人有　3：本人＆家族有））'#39442  ito 20180308　コメントに
Public MyNoPresence As Long  '#39810  ito 20180320　再追加　xmlの個人番号の有無判定（電子申請.xls内でのみ使用（雇保介護、社保異動・3号）入っている数字によって何人目の個人番号が入っているかを判定）
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
Sub 初期処理()
    Dim FSO
    Dim n As Integer
    Dim i As Integer
    Dim FileName As String
    Dim MyStr As String
    
    ThisWorkbook.Activate
    Worksheets("MENU").Select

'    IDとＰＷを表示
    FileName = Workbooks("DaMenu.xls").path & "\DaProcess\Da保存\電子申請申請者\申請者情報1.txt"
    Open FileName For Input As #1
        For i = 1 To 29
            Input #1, MyStr
            ActiveSheet.Cells(6, 4).value = MyStr
            MyStr = ""
        Next
    Close #1
    Open FileName For Input As #1
        For i = 1 To 30
            Input #1, MyStr
            ActiveSheet.Cells(7, 4).value = MyStr
            MyStr = ""
        Next
    Close #1
    
End Sub
Sub 終了へ()
    
    Application.Run "DaAddin.xla!閉じる"

End Sub
Sub 印刷()
    
    ActiveSheet.PrintOut

End Sub
Sub Da保存へ()
    
    Application.Run "DaAddin.xla!Da保存へ"

End Sub
Sub Da保存読込へ()

    Application.Run "DaAddin.xla!Da保存読込へ"

End Sub
Public Sub 未送信トレイ()

    frm未送信トレイ.Show

End Sub

'30055 Q&Aボタンの機能追加 hara
Public Sub QAの表示()
    Dim sheetName As String
    
    sheetName = ActiveSheet.Name
    Debug.Print sheetName
    
    Application.Run "CellsSupport.xlam!DisplayQA", sheetName, "台帳"
End Sub
'Public Sub 申請済リスト(Optional ByVal sql As String = vbNullString)
Public Sub 申請済リスト(Optional ByVal sql As String = "")

    ' 参照設定「Microsoft Active Data Object 2.x Library」
    Dim dbCon As New ADODB.Connection
    Dim dbRes As New ADODB.Recordset
    Dim dbCol As ADODB.Field
    Dim strSQL As String

    ' 画面描画更新停止
     Application.ScreenUpdating = False
    ThisWorkbook.Worksheets("送信済リスト").Protect UserInterfaceOnly:=True

    Worksheets("送信済リスト").Activate
    Worksheets("送信済リスト").Rows("3:65536").ClearContents
    Worksheets("送信済リスト").Rows("3:65536").ClearFormats '#26486
    
    InitDBObject DB_PATH, dbCon
    
    strSQL = "SELECT id,作成日,申請番号,申請先,会社名,社or雇or労,手続名,内容,到達番号,"
    strSQL = strSQL & "SWITCH(状況 = 1,'申請',状況 = 2,'到達',状況 = 3,'審査中',状況 = 4,'審査終了',状況 = 5,'手続終了',状況 = 6,'複数',"
    '#19505 20121018
    'strSQL = strSQL & "状況 = 7 AND LEFT(申請番号,14) < '" & Format(DateAdd("n", -5, Now), "YYYYMMDDHHmmss") & "','エラー')"
    strSQL = strSQL & "状況 = 7 ,'エラー')"
    'END  #19505
    
    '#35578 nr 2017/02/13 s
    'strSQL = strSQL & ",フォルダ名,その他1,その他2,その他3,担当,返戻フラグ FROM 申請データ WHERE (状況 <> 0 AND 状況 <> 99) "
    strSQL = strSQL & ",フォルダ名,その他1,その他2,その他3,担当,返戻フラグ,公文書処理日,公文書アップロード日 FROM 申請データ WHERE (状況 <> 0 AND 状況 <> 99) "
    '#35578 nr 2017/02/13 e
    
    '何日分表示するか取得する
            Dim nRet As Integer
            Dim mDay As String
            
            nRet = XXX_GetRegistryString(HKEY_CURRENT_USER, "software\cells\daityo", "DisplayDay", mDay)
               
            If IsNumeric(mDay) Then
                '1以上60以下使う
                If CInt(mDay) < 1 Or CInt(mDay) > 60 Then
                    mDay = "14"
                End If
            Else
                '数字でない場合は、14日(2週)分
                mDay = "14"
            End If
            strSQL = strSQL & "AND id > """ & Format(DateAdd("d", CInt(mDay) * -1, Now), "yyyymmdd") & String(9, "0") & """"
            nRet = XXX_SetRegistryString(HKEY_CURRENT_USER, "software\cells\daityo", "DisplayDay", mDay)
    
    'strSQL = strSQL & "AND id > """ & Format(DateAdd("m", -1, Now), "yyyymmdd") & String(9, "0") & """"
    strSQL = strSQL & " ORDER BY id DESC"

    If sql = vbNullString Then
        sql = strSQL
    End If
    
    dbRes.Open sql, dbCon, adOpenKeyset, adLockReadOnly
    Range("A3").CopyFromRecordset dbRes
    
    '色つける
    SetColor
    
    dbRes.Close
    
    Set dbRes = Nothing
    dbCon.Close
    
    Set dbCon = Nothing
    ' 画面描画更新復帰
    'Call GP_StartSCUPD
    Application.ScreenUpdating = True
         
    Worksheets("送信済リスト").Select

End Sub
Public Sub パーソナライズ起動()

    Dim objIE As Object
    Dim ret As String

    'ログイン
    InitIE objIE, True

    Set objIE = Nothing

End Sub
'
' IE初期化
'
Public Function InitIE(ByRef objIE As Object, Optional ByVal flg As Boolean = True) As Boolean

    Dim ret As Boolean
    ret = False

    Set objIE = CreateObject("InternetExplorer.Application")

    objIE.Visible = flg

    #If DEBUG_MODE Then
        objIE.Navigate (EGOV_TEST_URL_MAIN & "?egovparam=PK011K0001") '指定アドレスに飛ばす
    #Else
        objIE.Navigate (LOGIN_URL) 'LOGIN_URL
    #End If
'    IEWait objIE
'
'    If objIE.locationurl <> TARGET_URL Then
'        ret = False
'        InitIE = ret
'        Exit Function
'    End If
'
'    Do
'        ret = Login(objIE)
'    Loop Until objIE.locationurl <> LOGIN_URL Or ret = False

    InitIE = ret

End Function
Public Sub PID設定画面()

    frmP設定.Show

End Sub
'20110415 YBNO5741 笹 相対パス
Public Function GetDataPath(ByVal str As String) As String

    Dim lngPos As Long

    lngPos = InStrRev(str, "\") + 1

    GetDataPath = Mid(str, lngPos)

End Function
Public Sub DispFormat(ByVal path As String)

    Dim iCount As Long
    Dim FSO As Object
    Dim FileObj As Object
    Dim App As Object
    
    If Not IsExist(PathCombine(PathCombine(Workbooks("DaMenu.xls").path, "DaProcess\eGov\申請データ"), GetDataPath(path)), True) Then
        MsgBox "フォルダが見つかりません。", vbInformation + vbOKOnly, "一括申請"
        Exit Sub
    End If
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    For Each FileObj In FSO.GetFolder(Workbooks("DaMenu.xls").path & "\DaProcess\eGov\申請データ\" & GetDataPath(path)).Files
        If Right(FileObj, 7) = "_01.xml" Then
            DispXMLData Workbooks("DaMenu.xls").path & "\DaProcess\eGov\申請データ\" & GetDataPath(path) & "\" & GetDataPath(FileObj)
        End If
        If Right(FileObj, 4) = ".csv" Then
            Set App = CreateObject("Excel.Application")
            App.Visible = True
            App.Workbooks.Open Workbooks("DaMenu.xls").path & "\DaProcess\eGov\申請データ\" & GetDataPath(path) & "\" & GetDataPath(FileObj)
            Set App = Nothing
        End If
    Next FileObj
    
    If ExsitMyNoForDir(PathCombine(PathCombine(Workbooks("DaMenu.xls").path, "DaProcess\eGov\申請データ"), GetDataPath(path))) Then
        If Application.Run("DaAddin.xla!MNMode", True, False) Then
            ApplyLog path, "申請書の表示"
        End If
    End If
    
    Set FSO = Nothing
    
End Sub
Public Sub ApplyLog(ByVal path As String, ByVal str As String)

    Dim DataFolder As String
    
    DataFolder = PathCombine(PathCombine(Workbooks("DaMenu.xls").path, "DaProcess\eGov\申請データ"), GetDataPath(path))
        
    Dim CompanyAccount As String
    
    '#40033  ito 20180125　da名を変数に変更
    ''#36475  ito 20170306　da名に変更
    '''YBNO 31594/31624/31625  ito 20160506
    '''CompanyAccount = Application.Run("GetCompanyAccountByCompanyName", XmlValue(PathCombine(DataFolder, XMLDataToDataFileName(PathCombine(DataFolder, "kousei.xml"))), "//事業所名|//事業所名称|//事業所名略称"))
    ''CompanyAccount = Application.Run("GetCompanyAccountByCompanyName", XmlValue(PathCombine(DataFolder, XMLDataToDataFileName(PathCombine(DataFolder, "kousei.xml"))), "//事業所名|//事業所名称|//事業所名略称|//事業所名_所在地"))
    'CompanyAccount = Application.Run("GetCompanyAccount", frm未送信トレイ.lstData.List(frm未送信トレイ.lstData.ListIndex, 8) & "da.xls")
    CompanyAccount = Application.Run("GetCompanyAccount", LogDaName)
                        
    Dim summry As String
    
    summry = XMLDataToProcName(PathCombine(DataFolder, "kousei.xml"))
    
    Dim procfilemei As String

    procfilemei = XMLDataToDataFileName(PathCombine(DataFolder, "kousei.xml"))

    Dim col As Collection
    Dim item As Variant  '#39810  ito 20180315　H30新様式対応　追加
    If procfilemei = "495000020161029113_01.xml" Or procfilemei = "495000020162029115_01.xml" Then
        If procfilemei = "495000020161029113_01.xml" Then
            Set col = CsvPersonNameCollection(PathCombine(DataFolder, KOHO_CSV_FILE_NAME_SYUTOKU), 8)
        Else
            Set col = CsvPersonNameCollection(PathCombine(DataFolder, KOHO_CSV_FILE_NAME_SOSHITU), 23)
        End If
        'Dim item As Variant  '#39810  ito 20180315　H30新様式対応　コメントに
        For Each item In col
            Application.Run "DaAddin.xla!ProcLogging", CompanyAccount, PROC_NAME, str, summry, vbNullString, item, "成功"
        Next
        
'★9.00.31でコメント外す
'    '#39810  ito 20180315　H30新様式対応　追加　------------------------------------------------------------------------------
'    ElseIf procfilemei = "495000020582030137_01.xml" Then  '取得
'        Set col = CsvPersonNameCollection(PathCombine(DataFolder, SYAHO_CSV_FILE_NAME), 7)
'        For Each item In col
'            Application.Run "DaAddin.xla!ProcLogging", CompanyAccount, PROC_NAME, str, summry, vbNullString, item, "成功"
'        Next
'    ElseIf procfilemei = "495000020583030137_01.xml" Then  '喪失
'        Set col = CsvPersonNameCollection(PathCombine(DataFolder, SYAHO_CSV_FILE_NAME), 7)
'        For Each item In col
'            Application.Run "DaAddin.xla!ProcLogging", CompanyAccount, PROC_NAME, str, summry, vbNullString, item, "成功"
'        Next
'    ElseIf procfilemei = "495000020584030137_01.xml" Then   '算定
'        Set col = CsvPersonNameCollection(PathCombine(DataFolder, SYAHO_CSV_FILE_NAME), 6)
'        For Each item In col
'            Application.Run "DaAddin.xla!ProcLogging", CompanyAccount, PROC_NAME, str, summry, vbNullString, item, "成功"
'        Next
'    ElseIf procfilemei = "495000020585030137_01.xml" Then   '月変
'        Set col = CsvPersonNameCollection(PathCombine(DataFolder, SYAHO_CSV_FILE_NAME), 6)
'        For Each item In col
'            Application.Run "DaAddin.xla!ProcLogging", CompanyAccount, PROC_NAME, str, summry, vbNullString, item, "成功"
'        Next
'    ElseIf procfilemei = "495000020586030137_01.xml" Then   '賞与
'        Set col = CsvPersonNameCollection(PathCombine(DataFolder, SYAHO_CSV_FILE_NAME), 6)
'        For Each item In col
'            Application.Run "DaAddin.xla!ProcLogging", CompanyAccount, PROC_NAME, str, summry, vbNullString, item, "成功"
'        Next
'    '#39810  -----------------------------------------------------------------------------------------------------------------
    
    '#37887  ito 20170627　追加　-----------------------------------------------------------------------------------------------------------------------------------------------------------
    '#39442  ito 20180308　H30仕様変更対応
    'ElseIf procfilemei = "495000020458030005_01.xml" Then  '介護休業給付だったら
    '    Dim KaigoName As String
    '    If MyNoPresence > 1 Then '被保険者の個人番号有
    '        Application.Run "DaAddin.xla!ProcLogging", CompanyAccount, PROC_NAME, str, summry, vbNullString, XmlValue(PathCombine(DataFolder, procfilemei), "//申請者氏名_フリガナ"), "成功"
    '    End If
    '    If MyNoPresence = 1 Or MyNoPresence = 3 Then   '介護対象家族の個人番号有
    '        KaigoName = XmlValue(PathCombine(DataFolder, procfilemei), "//介護対象家族の姓_カタカナ")
    '        KaigoName = KaigoName & "　" & XmlValue(PathCombine(DataFolder, procfilemei), "//介護対象家族の名_カタカナ")
    '        Application.Run "DaAddin.xla!ProcLogging", CompanyAccount, PROC_NAME, str, summry, vbNullString, KaigoName, "成功"
    '    End If
    ElseIf procfilemei = "495000020631030280_01.xml" Then  '介護休業給付だったら
        Dim KaigoName As String
        If InStr(MyNoPresence, 1) > 0 Then '被保険者の個人番号有  '#39810  ito 20180320　追加
            KaigoName = XmlValue(PathCombine(DataFolder, procfilemei), "//被保険者の姓")
            KaigoName = KaigoName & "　" & XmlValue(PathCombine(DataFolder, procfilemei), "//被保険者の名")
            Application.Run "DaAddin.xla!ProcLogging", CompanyAccount, PROC_NAME, str, summry, vbNullString, KaigoName, "成功"
        End If  '#39810  ito 20180320　追加
        If InStr(MyNoPresence, 2) > 0 Then  '介護対象家族の個人番号有  '#39810  ito 20180320　追加
            KaigoName = XmlValue(PathCombine(DataFolder, procfilemei), "//介護対象家族の姓_漢字")
            KaigoName = KaigoName & "　" & XmlValue(PathCombine(DataFolder, procfilemei), "//介護対象家族の名_漢字")
            Application.Run "DaAddin.xla!ProcLogging", CompanyAccount, PROC_NAME, str, summry, vbNullString, KaigoName, "成功"
        End If  '#39810  ito 20180320　追加
    '#37887  -------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
    Else
        '#39810  ito 20180320　H30新様式対応
        ''YBNO 31594/31624/31625  ito 20160509
        ''Application.Run "DaAddin.xla!ProcLogging", CompanyAccount, PROC_NAME, str, summry, vbNullString, XmlValue(PathCombine(DataFolder, procfilemei), "//被保険者氏名|//氏名カタカナ"), "成功"
        'Application.Run "DaAddin.xla!ProcLogging", CompanyAccount, PROC_NAME, str, summry, vbNullString, XmlValue(PathCombine(DataFolder, procfilemei), "//被保険者氏名|//氏名カタカナ|//申請者氏名"), "成功"
        '【雇保介護/社保異動・3号以外の様式記入用】
        If MyNoPresence = 0 Then  '1人目
            Application.Run "DaAddin.xla!ProcLogging", CompanyAccount, PROC_NAME, str, summry, vbNullString, XmlValue(PathCombine(DataFolder, procfilemei), "//被保険者氏名|//氏名カタカナ|//申請者氏名|//P1_氏名x漢字氏名|//P1_漢字氏名"), "成功"
        End If
        '【社保異動・3号用】
        If InStr(MyNoPresence, 1) > 0 Then  '1人目
            Application.Run "DaAddin.xla!ProcLogging", CompanyAccount, PROC_NAME, str, summry, vbNullString, XmlValue(PathCombine(DataFolder, procfilemei), "//P1_被保険者氏名x漢字氏名|//P1_配偶者x氏名x漢字氏名|//配偶者の氏名"), "成功"
        End If
        If InStr(MyNoPresence, 2) > 0 Then  '2人目
            Application.Run "DaAddin.xla!ProcLogging", CompanyAccount, PROC_NAME, str, summry, vbNullString, XmlValue(PathCombine(DataFolder, procfilemei), "//P1_第3号被保険者氏名x漢字氏名|//P1_第3号被保険者x氏名x漢字氏名|//被保険者氏名x漢字x"), "成功"
        End If
        If InStr(MyNoPresence, 3) > 0 Then  '3人目
            Application.Run "DaAddin.xla!ProcLogging", CompanyAccount, PROC_NAME, str, summry, vbNullString, XmlValue(PathCombine(DataFolder, procfilemei), "//P2_その他の被扶養者1x氏名x漢字氏名"), "成功"
        End If
        If InStr(MyNoPresence, 4) > 0 Then  '4人目
            Application.Run "DaAddin.xla!ProcLogging", CompanyAccount, PROC_NAME, str, summry, vbNullString, XmlValue(PathCombine(DataFolder, procfilemei), "//P2_その他の被扶養者2x氏名x漢字氏名"), "成功"
        End If
        If InStr(MyNoPresence, 5) > 0 Then  '5人目
            Application.Run "DaAddin.xla!ProcLogging", CompanyAccount, PROC_NAME, str, summry, vbNullString, XmlValue(PathCombine(DataFolder, procfilemei), "//P2_その他の被扶養者3x氏名x漢字氏名"), "成功"
        End If
    End If

    LogDaName = ""  '#40033  ito 20180125　追加
    
End Sub
Public Sub DispDataFolder(ByVal path As String)

    Dim str As String

    If Not IsExist(PathCombine(PathCombine(Workbooks("DaMenu.xls").path, "DaProcess\eGov\申請データ"), GetDataPath(path)), True) Then
        MsgBox "フォルダが見つかりません。", vbInformation + vbOKOnly, "一括申請"
        Exit Sub
    End If

    str = PathCombine(Environ("windir"), "EXPLORER.EXE") & " " & Workbooks("DaMenu.xls").path & "\DaProcess\eGov\申請データ\" & GetDataPath(path)

    Shell str, vbNormalFocus

    If ExsitMyNoForDir(PathCombine(PathCombine(Workbooks("DaMenu.xls").path, "DaProcess\eGov\申請データ"), GetDataPath(path))) Then
        If Application.Run("DaAddin.xla!MNMode", True, False) Then
            ApplyLog path, "データフォルダの表示"
        End If
    End If

End Sub
'END 20110415 YBNO5741 笹 相対パス
Public Sub cmdSearch_Click()

    frmSearch.Show

End Sub
Public Sub cmdBack_Click()

    SearchSQL = vbNullString
    ThisWorkbook.Sheets("MENU").Select

End Sub
Public Sub cmdPrint_Click()
    
    If MsgBox("プリンタの準備はいいですか？", 1 + 32, "印刷") <> 1 Then Exit Sub
    
    On Error GoTo EPROC:
    Range("B3:O" & Range("$A$65536").End(xlUp).Row).PrintOut
    Exit Sub
EPROC:
    MsgBox "印刷を中止したのか、失敗しました。", vbInformation + vbOKOnly, "送信済リスト"
End Sub
Public Sub cmdUpdate_Click()

    Dim iCount As Long
    Dim iSumCount As Long
    Dim SousinNo As String
    Dim ToutatuNo As String

    If ThisWorkbook.ReadOnly = True Then
        MsgBox "他のユーザーが申請中あるいは、データ管理中です。本処理できるのは一人だけです。", vbInformation + vbOKOnly, "読み取り専用"
        Exit Sub
    End If

    '対象の件数を調べて、大まかな時間を表示する。
    iSumCount = ActiveSheet.Range("$A$65536").End(xlUp).Row - 2
    
    If iSumCount < 1 Then Exit Sub
    
    If MsgBox("到達番号と状況をE-GOVから取得しますか。" & vbCrLf & "(" & iSumCount & "件のデータがあります。" & 10 * iSumCount & "秒以上かかる場合があります。)", vbOKCancel + vbQuestion, "E-GOV") = vbCancel Then Exit Sub

    Load frmProgress
    frmProgress.Caption = "一括申請"
    frmProgress.Enabled = False
   
    'Dim Send As New egov.Send
    Dim Send As Object
…

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