MALICIOUS
218
Risk Score
Malware Insights
MITRE ATT&CK
T1059.005 Visual Basic
T1105 Ingress Tool Transfer
T1071.001 Web Protocols
The sample is an Excel document containing a Workbook_Open VBA macro that utilizes WScript.Shell and CreateObject/GetObject calls. The macro appears to be designed to download and execute a second-stage payload from the URLs hosted on '27.121.93.114'. The document body content, while in Japanese, suggests a patent search tool, likely a lure to trick users into enabling macros. The presence of WScript.Shell usage and the download URLs strongly indicate malicious intent.
Heuristics 8
-
VBA project inside OOXML medium 6 related findings OOXML_VBADocument contains a VBA project — VBA macros present
-
WScript.Shell usage critical OLE_VBA_WSCRIPTWScript.Shell usageMatched line in script
Set wShell = CreateObject("WScript.Shell") '/*B0200_3001*/ -
CreateObject call high OLE_VBA_CREATEOBJCreateObject callMatched line in script
Set objFso = CreateObject("Scripting.FileSystemObject") -
GetObject call high OLE_VBA_GETOBJGetObject callMatched line in script
For Each objNetwork In GetObject("winmgmts:").ExecQuery(strNetworkSql) '/*B0200_3001*/ -
VBA p-code auto-exec with execution tokens high OLE_VBA_PCODE_AUTOEXEC_EXECTriggers on the COMBINATION of two tokens co-occurring in the same compiled VBA/cache stream: an auto-execution entry point (Auto_Open / AutoOpen / Document_Open / Workbook_Open / Auto_Close / AutoClose) AND a shell/download/object-execution token (Shell, CreateObject, GetObject, PowerShell, cmd.exe, URLDownloadToFile, WinHttp, XMLHTTP, ADODB.Stream, ShellExecute, ExecuteExcel4Macro). Neither token alone fires it — it is the pairing that flags p-code-only or source-extraction-failure macro documents where the visible VBA source is unavailable. The matched tokens are named in the detail line below.
-
Workbook_Open macro low OLE_VBA_WBOPENWorkbook_Open macroMatched line in script
Private Sub Workbook_Open() -
Environ() call (env variable access) low OLE_VBA_ENVIRONEnviron() call (env variable access)Matched line in script
FileNamePath = Environ("TMP") -
Embedded URL info EMBEDDED_URLOne 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://27.121.93.114/SR-C/Main/View/OutLineContinueStartOFF.aspx?FileName={0}&Count={1}&User={2 In document text (OOXML body / shared strings)
- http://27.121.93.114/SR-C/Main/View/OutLineContinueFile.aspxIn document text (OOXML body / shared strings)
- http://27.121.93.114/SR-C/Main/Download/ExcelUpload.aspxIn document text (OOXML body / shared strings)
- http://27.121.93.114/SR-C/Main/Download/ExcelUploadCSV.aspxIn document text (OOXML body / shared strings)
- http://27.121.93.114/SR-C/Main/View/OutLineTransfer.aspx?KohoNo={0}&Index=0&KindUserID=shinfo004In document text (OOXML body / shared strings)
- http://27.121.93.114/SR-C/Main/View/Syoukai.aspx?No={0}&ZenbunFlag=1&Index=0&USERID=shinfo004In document text (OOXML body / shared strings)
- http://27.121.93.114/SR-C/Main/View/Syoukai.aspx?No={0}&LayoutFlag=1&USERID=shinfo004In document text (OOXML body / shared strings)
Extracted artifacts 2
Files carved from inside the sample during analysis.
| Filename | Kind | Source | Size |
|---|---|---|---|
macros.bas |
vba-macro | oletools.olevba.extract_macros (decoded VBA source from OOXML) | 139850 bytes |
SHA-256: ec46c0cbb028a871f654f61513186c9128df5d1b973c21923051efc74f609a29 |
|||
Preview scriptFirst 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_Open()
'グローバル変数初期化
Dim Sheet1OBJ As Sheet1
Set Sheet1OBJ = Sheet1
'初期化
Sheet1OBJ.HeaderRangeInit
g_ALLDisp_SubMenuName = g_InfoSheetOBJ.Range("全一括表示").Value '//#B87_0242
g_Update_SubMenuName = g_InfoSheetOBJ.Range("更新アップロード").Value '//#B87_0242
g_Upload_SubMenuName = g_InfoSheetOBJ.Range("文献アップロード").Value '//#B87_0242
If g_InfoSheetOBJ.Range("SYS_LANG_FLAG").Value = "zh" Then
'TOPメニューの設定（中国、台湾、香港、マカオ）
If Application.International(xlCountryCode) = 86 _
Or Application.International(xlCountryCode) = 886 _
Or Application.International(xlCountryCode) = 852 _
Or Application.International(xlCountryCode) = 853 _
Then
g_TopMenuName = "&digi-patent/s"
ElseIf Application.International(xlCountryCode) = 81 _
Then
g_TopMenuName = "&Shareresearch"
Else
g_TopMenuName = "&digi-patent/s"
End If
Else
g_TopMenuName = "&Shareresearch"
End If
'メニュー追加処理 //#B60_0138
MakeMenu '//#B60_0138
End Sub
'メニュートップ文字取得
'//#B60_0138
Public Function GetTopMenuName() As String
GetTopMenuName = g_TopMenuName
Exit Function
End Function
'サブメニュー 全一括表示文字取得
'//#B60_0138
Public Function GetALLDisp_SubMenuName() As String
GetALLDisp_SubMenuName = g_ALLDisp_SubMenuName
Exit Function
End Function
'サブメニュー 更新アップロード文字取得
'//#B60_0138
Public Function GetUpdate_SubMenuName() As String
GetUpdate_SubMenuName = g_Update_SubMenuName
Exit Function
End Function
'サブメニュー 文献アップロード文字取得
'//#B60_0138
Public Function GetUpload_SubMenuName() As String
GetUpload_SubMenuName = g_Upload_SubMenuName
Exit Function
End Function
'ブックアクティブイベント
'//#B60_0138
Private Sub Workbook_WindowActivate(ByVal Wn As Window)
Dim MenuOBJ As Variant
For Each MenuOBJ In Application.CommandBars("Worksheet Menu Bar").Controls
If MenuOBJ.Caption = GetTopMenuName() Then
Exit Sub
End If
Next
MakeMenu '//#B90_0095
End Sub
'ブック非アクティブイベント
'//#B60_0138
Private Sub Workbook_WindowDeactivate(ByVal Wn As Window)
Dim MenuOBJ As Variant
For Each MenuOBJ In Application.CommandBars("Worksheet Menu Bar").Controls
If MenuOBJ.Caption = GetTopMenuName() Then
MenuOBJ.Delete '//#B90_0095
Exit Sub
End If
Next
End Sub
'メニュー作成,初期化処理
'//#B60_0138
Private Sub MakeMenu()
Dim NewM As Variant
Dim SubNewM As Variant
Dim Sheet1OBJ As Sheet1
Dim HeaderOBJ As Sheet4
Dim MenuOBJ As Variant
Dim SubMenuOBJ As Variant
On Error GoTo MENU_ERROR
Set Sheet1OBJ = ActiveWorkbook.Worksheets(g_Sheet1Name)
Set HeaderOBJ = ActiveWorkbook.Worksheets(g_Sheet4Name)
Set NewM = Application.CommandBars("Worksheet Menu Bar").Controls.Add( _
Type:=msoControlPopup, Temporary:=True)
NewM.Caption = GetTopMenuName()
Set SubNewM = NewM.Controls.Add
With SubNewM
.Caption = GetALLDisp_SubMenuName()
.OnAction = "ALLDisp_SubMenu_Command"
.BeginGroup = False
.Enabled = Sheet1OBJ.GetALLDisp_SubMenuEnable()
End With
Set SubNewM = NewM.Controls.Add
With SubNewM
.Caption = GetUpdate_SubMenuName()
.OnAction = "Update_SubMenu_Command"
.BeginGroup = False
.Enabled = Sheet1OBJ.GetUpdate_SubMenuEnable()
End With
Set SubNewM = NewM.Controls.Add
With SubNewM
.Caption = GetUpload_SubMenuName()
.OnAction = "Upload_SubMenu_Command"
.BeginGroup = False
.Enabled = Sheet1OBJ.GetUpload_SubMenuEnable()
End With
MENU_ERROR:
'// エラー時は何もしないで終了
End Sub
Attribute VB_Name = "Sheet1"
Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True
Option Explicit
#If VBA7 Then '//#B0204_0134
Private Declare PtrSafe Function OpenIcon Lib "user32" (ByVal hWnd As LongPtr) As Long '//#B0204_0134
Private Declare PtrSafe Function SetForegroundWindow Lib "user32" (ByVal hWnd As LongPtr) As Long '//#B0204_0134
Private Declare PtrSafe Sub Sleep Lib "KERNEL32.dll" (ByVal dwMilliseconds As Long) '//#B0204_0134
#Else '//#B0204_0134
Private Declare Function OpenIcon Lib "user32" (ByVal hWnd As Long) As Long '//#B40_0020
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As Long '//#B40_0020
Private Declare Sub Sleep Lib "KERNEL32.dll" (ByVal dwMilliseconds As Long) '//#B63_0052
#End If '//#B0204_0134
Public WithEvents g_IEOBJ As InternetExplorer '//#B31_0022
Attribute g_IEOBJ.VB_VarHelpID = -1
Public WithEvents g_SyourokuIEOBJ As InternetExplorer '//#B40_0020
Attribute g_SyourokuIEOBJ.VB_VarHelpID = -1
Public WithEvents g_UploadIEOBJ As InternetExplorer '//#B40_0025
Attribute g_UploadIEOBJ.VB_VarHelpID = -1
'Public g_KouhouNO_RangeName As String '//#B40_0020//#B60_0138
Public g_Hyouka_RangeName As String '//#B40_0020
Public g_Memo00_RangeName As String '//#B40_0020
Public g_Memo01_RangeName As String '//#B40_0020
Public g_Memo02_RangeName As String '//#B40_0020
Public g_Memo03_RangeName As String '//#B40_0020
Public g_Memo04_RangeName As String '//#B40_0020
Public g_Memo05_RangeName As String '//#B40_0020
Public g_Memo06_RangeName As String '//#B40_0020
Public g_Memo07_RangeName As String '//#B40_0020
Public g_Memo08_RangeName As String '//#B40_0020
Public g_Memo09_RangeName As String '//#B40_0020
Public g_Memo10_RangeName As String '//#B40_0020
Public g_YOUYAKU_RangeName As String '//#B60_0125
Public g_SEIHIN_RangeName As String '//#B60_0125
Public g_HYOUKA_DB_RangeName As String '//#B60_0125
Public g_HYOUKARIYU_RangeName As String '//#B60_0125
Public g_BUNRUI1_RangeName As String '//#B60_0125
Public g_BUNRUI2_RangeName As String '//#B60_0125
Public g_BUNRUI3_RangeName As String '//#B60_0125
Public g_BUNRUI4_RangeName As String '//#B60_0125
Public g_BUNRUI5_RangeName As String '//#B60_0125
Public g_RELATION_GROUP_RangeName As String '//#B62_0005
Public g_HYOUKA_COMMENT_RangeName As String '//#B62_0005
Public g_KEYWORD_RangeName As String '//#B62_0005
Public g_JISYAJOUKYOU_RangeName As String '//#B62_0006
Public g_JISYAJOUKYOU_DETAIL_RangeName As String '//#B62_0006
Public g_TAISAKUAN_RangeName As String '//#B62_0006
Public g_FREE_ITEM1_RangeName As String '//#B84_0327
Public g_FREE_ITEM2_RangeName As String '//#B84_0327
Public g_FREE_ITEM3_RangeName As String '//#B84_0327
Public g_FREE_ITEM4_RangeName As String '//#B84_0327
Public g_FREE_ITEM5_RangeName As String '//#B84_0327
Public g_HeaderSheetOBJ As Sheet4 '//#B60_0138
Public g_PROC_BUNRUI1_RangeName As String '//#B67_0009
Public g_PROC_BUNRUI2_RangeName As String '//#B67_0009
Public g_PROC_BUNRUI3_RangeName As String '//#B67_0009
Public g_PROC_BUNRUI4_RangeName As String '//#B67_0009
Public g_PROC_BUNRUI5_RangeName As String '//#B67_0009
Public g_USER_YOUYAKU_RangeName As String '//#B67_0009
Public g_USER_SEIHIN_RangeName As String '//#B67_0009
Public g_USER_HYOUKA_DB_RangeName As String '//#B67_0009
Public g_USER_HYOUKARIYU_RangeName As String '//#B67_0009
Public g_USER_BUNRUI1_RangeName As String '//#B67_0009
Public g_USER_BUNRUI2_RangeName As String '//#B67_0009
Public g_USER_BUNRUI3_RangeName As String '//#B67_0009
Public g_USER_BUNRUI4_RangeName As String '//#B67_0009
Public g_USER_BUNRUI5_RangeName As String '//#B67_0009
Public g_USER_RELATION_GROUP_RangeName As String '//#B67_0009
Public g_USER_HYOUKA_COMMENT_RangeName As String '//#B67_0009
Public g_USER_KEYWORD_RangeName As String '//#B67_0009
Public g_USER_JISYAJOUKYOU_RangeName As String '//#B67_0009
Public g_USER_JISYAJOUKYOU_DETAIL_RangeName As String '//#B67_0009
Public g_USER_TAISAKUAN_RangeName As String '//#B67_0009
Public g_USER_FREE_ITEM1_RangeName As String '//#B84_0327
Public g_USER_FREE_ITEM2_RangeName As String '//#B84_0327
Public g_USER_FREE_ITEM3_RangeName As String '//#B84_0327
Public g_USER_FREE_ITEM4_RangeName As String '//#B84_0327
Public g_USER_FREE_ITEM5_RangeName As String '//#B84_0327
Public g_USER_PROC_BUNRUI1_RangeName As String '//#B67_0009
Public g_USER_PROC_BUNRUI2_RangeName As String '//#B67_0009
Public g_USER_PROC_BUNRUI3_RangeName As String '//#B67_0009
Public g_USER_PROC_BUNRUI4_RangeName As String '//#B67_0009
Public g_USER_PROC_BUNRUI5_RangeName As String '//#B67_0009
Public g_CLASS_RangeName As String '//#B68_0034
'見出し情報変数の初期化
'//#B40_0020
Public Function HeaderRangeInit()
'g_KouhouNO_RangeName = "KOUHOUNO" //#B60_0138
g_Hyouka_RangeName = "HYOUKA"
g_Memo00_RangeName = "MEMO_00"
g_Memo01_RangeName = "MEMO_01"
g_Memo02_RangeName = "MEMO_02"
g_Memo03_RangeName = "MEMO_03"
g_Memo04_RangeName = "MEMO_04"
g_Memo05_RangeName = "MEMO_05"
g_Memo06_RangeName = "MEMO_06"
g_Memo07_RangeName = "MEMO_07"
g_Memo08_RangeName = "MEMO_08"
g_Memo09_RangeName = "MEMO_09"
g_Memo10_RangeName = "MEMO_10"
g_YOUYAKU_RangeName = "YOUYAKU" '//#B60_0125
g_SEIHIN_RangeName = "SEIHIN" '//#B60_0125
g_HYOUKA_DB_RangeName = "HYOUKA_DB" '//#B60_0125
g_HYOUKARIYU_RangeName = "HYOUKARIYU" '//#B60_0125
g_BUNRUI1_RangeName = "BUNRUI1" '//#B60_0125
g_BUNRUI2_RangeName = "BUNRUI2" '//#B60_0125
g_BUNRUI3_RangeName = "BUNRUI3" '//#B60_0125
g_BUNRUI4_RangeName = "BUNRUI4" '//#B60_0125
g_BUNRUI5_RangeName = "BUNRUI5" '//#B60_0125
g_RELATION_GROUP_RangeName = "RELATION_GROUP" '//#B62_0005
g_HYOUKA_COMMENT_RangeName = "HYOUKA_COMMENT" '//#B62_0005
g_KEYWORD_RangeName = "KEYWORD" '//#B62_0005
g_JISYAJOUKYOU_RangeName = "JISYAJOUKYOU" '//#B62_0006
g_JISYAJOUKYOU_DETAIL_RangeName = "JISYAJOUKYOU_DETAIL" '//#B62_0006
g_TAISAKUAN_RangeName = "TAISAKUAN" '//#B62_0006
g_FREE_ITEM1_RangeName = "FREE_ITEM1" '//#B84_0327
g_FREE_ITEM2_RangeName = "FREE_ITEM2" '//#B84_0327
g_FREE_ITEM3_RangeName = "FREE_ITEM3" '//#B84_0327
g_FREE_ITEM4_RangeName = "FREE_ITEM4" '//#B84_0327
g_FREE_ITEM5_RangeName = "FREE_ITEM5" '//#B84_0327
g_PROC_BUNRUI1_RangeName = "PROC_BUNRUI1" '//#B67_0009
g_PROC_BUNRUI2_RangeName = "PROC_BUNRUI2" '//#B67_0009
g_PROC_BUNRUI3_RangeName = "PROC_BUNRUI3" '//#B67_0009
g_PROC_BUNRUI4_RangeName = "PROC_BUNRUI4" '//#B67_0009
g_PROC_BUNRUI5_RangeName = "PROC_BUNRUI5" '//#B67_0009
g_USER_YOUYAKU_RangeName = "USER_YOUYAKU" '//#B67_0009
g_USER_SEIHIN_RangeName = "USER_SEIHIN" '//#B67_0009
g_USER_HYOUKA_DB_RangeName = "USER_HYOUKA_DB" '//#B67_0009
g_USER_HYOUKARIYU_RangeName = "USER_HYOUKARIYU" '//#B67_0009
g_USER_BUNRUI1_RangeName = "USER_BUNRUI1" '//#B67_0009
g_USER_BUNRUI2_RangeName = "USER_BUNRUI2" '//#B67_0009
g_USER_BUNRUI3_RangeName = "USER_BUNRUI3" '//#B67_0009
g_USER_BUNRUI4_RangeName = "USER_BUNRUI4" '//#B67_0009
g_USER_BUNRUI5_RangeName = "USER_BUNRUI5" '//#B67_0009
g_USER_RELATION_GROUP_RangeName = "USER_RELATION_GROUP" '//#B67_0009
g_USER_HYOUKA_COMMENT_RangeName = "USER_HYOUKA_COMMENT" '//#B67_0009
g_USER_KEYWORD_RangeName = "USER_KEYWORD" '//#B67_0009
g_USER_JISYAJOUKYOU_RangeName = "USER_JISYAJOUKYOU" '//#B67_0009
g_USER_JISYAJOUKYOU_DETAIL_RangeName = "USER_JISYAJOUKYOU_DETAIL" '//#B67_0009
g_USER_TAISAKUAN_RangeName = "USER_TAISAKUAN" '//#B67_0009
g_USER_FREE_ITEM1_RangeName = "USER_FREE_ITEM1" '//#B84_0327
g_USER_FREE_ITEM2_RangeName = "USER_FREE_ITEM2" '//#B84_0327
g_USER_FREE_ITEM3_RangeName = "USER_FREE_ITEM3" '//#B84_0327
g_USER_FREE_ITEM4_RangeName = "USER_FREE_ITEM4" '//#B84_0327
g_USER_FREE_ITEM5_RangeName = "USER_FREE_ITEM5" '//#B84_0327
g_USER_PROC_BUNRUI1_RangeName = "USER_PROC_BUNRUI1" '//#B67_0009
g_USER_PROC_BUNRUI2_RangeName = "USER_PROC_BUNRUI2" '//#B67_0009
g_USER_PROC_BUNRUI3_RangeName = "USER_PROC_BUNRUI3" '//#B67_0009
g_USER_PROC_BUNRUI4_RangeName = "USER_PROC_BUNRUI4" '//#B67_0009
g_USER_PROC_BUNRUI5_RangeName = "USER_PROC_BUNRUI5" '//#B67_0009
g_CLASS_RangeName = "CLASS" '//#B68_0034
Set g_InfoSheetOBJ = ActiveWorkbook.Worksheets("INFO") '//#B87_0242
g_Sheet1Name = g_InfoSheetOBJ.Range("ダウンロード項目").Value '//#B87_0242
g_Sheet4Name = g_InfoSheetOBJ.Range("ダウンロード情報").Value '//#B87_0242
Set g_HeaderSheetOBJ = ActiveWorkbook.Worksheets(g_Sheet4Name) '//#B60_0138
End Function
'ファイルアップロード(Chrome対応)
'/*B0200_3001*/
Private Function FileUpload(strUploadUrl As String, strFilePath As String, strUserId As String)
Dim objStream As Object 'Stream
Dim objFso As Object 'FileSystemObject
Dim objXmlHttp As Object 'XMLHTTP
Dim strFileName As String
Dim strParam As String
Dim sendData As Variant
Dim fileContents As Variant
Dim strRes As String
Dim nStatus As Integer
FileUpload = 0 'リターン値の初期化
' ファイル名取得
Set objFso = CreateObject("Scripting.FileSystemObject")
strFileName = objFso.GetFileName(strFilePath)
Set objFso = Nothing
' 送信ファイル読込
Set objStream = CreateObject("ADODB.Stream")
objStream.Type = ADTYPE_BINARY
objStream.Open
objStream.LoadFromFile = strFilePath
fileContents = objStream.Read
objStream.Close
' 送信フォーム設定
Set objXmlHttp = CreateObject("MSXML2.XMLHTTP.3.0")
objXmlHttp.Open "POST", strUploadUrl, False
objXmlHttp.setRequestHeader "Content-Type", "multipart/form-data; boundary=""AaB03x"""
' リクエストパラメータを設定
strParam = strParam & "--AaB03x" & vbCrLf
strParam = strParam & "Content-Disposition: form-data; name=""User""" & vbCrLf & vbCrLf
strParam = strParam & strUserId & vbCrLf
strParam = strParam & "--AaB03x" & vbCrLf
strParam = strParam & "Content-Disposition: form-data; name=""fileName""; filename=""" + strFileName + """" & vbCrLf
strParam = strParam & "Content-Type: text/plain" & vbCrLf & vbCrLf
' リクエストパラメータ書き込み
objStream.Type = ADTYPE_TEXT
objStream.Charset = "Shift-JIS"
objStream.Open
objStream.WriteText (strParam)
' ファイル内容書き込み
Call ChangeStreamType(objStream, ADTYPE_BINARY)
objStream.Write fileContents
Call ChangeStreamType(objStream, ADTYPE_TEXT)
objStream.WriteText (vbCrLf & "--AaB03x--")
' Http送信
Call ChangeStreamType(objStream, ADTYPE_BINARY)
objStream.Position = 0
sendData = objStream.Read
objStream.Close
objXmlHttp.send (sendData)
' ステータスの取得
nStatus = objXmlHttp.Status
' レスポンスの取得
strRes = objXmlHttp.responseText
Set objXmlHttp = Nothing
Set objStream = Nothing
If (nStatus <> 200 Or strRes = "-1") Then
MsgBox2 g_InfoSheetOBJ.Range("アップロード時にエラーが発生しました").Value
FileUpload = -1
ElseIf (strRes <> "0") Then
' リダイレクト先に再送（CTRL対応）
Set objXmlHttp = CreateObject("MSXML2.XMLHTTP.3.0")
objXmlHttp.Open "POST", strRes, False
objXmlHttp.setRequestHeader "Content-Type", "multipart/form-data; boundary=""AaB03x"""
objXmlHttp.send (sendData)
nStatus = objXmlHttp.Status
strRes = objXmlHttp.responseText
Set objXmlHttp = Nothing
If (nStatus <> 200 Or strRes <> "0") Then
MsgBox2 g_InfoSheetOBJ.Range("アップロード時にエラーが発生しました").Value
FileUpload = -1
End If
End If
' TMPファイル削除
Kill strFilePath
Exit Function
End Function
'公報アンカーイベント(IE起動処理)
'//#B31_0022
Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
Dim Address As String
Address = Target.SubAddress
'//#B50_0276 -->
If Target.Address <> "" Or Address <> "" Then '//#B83_0014
Exit Sub
End If
'<-- //#B50_0276
Address = Target.TextToDisplay '//#B67_0180
Dim InfoSheetOBJ As Worksheet '//#B60_0190
Set InfoSheetOBJ = Worksheets("INFO") '//#B60_0190
Dim nURLAddFlag As Integer '//#B65_0009
nURLAddFlag = 0 '//#B65_0009
Dim TipWork As String '//#B67_0180
TipWork = Target.TextToDisplay & " " '//#B67_0180
Dim TipWork2 As String '//#B70_0044
TipWork2 = Target.TextToDisplay & " " '//#B70_0044
Dim TipWork3 As String '//#B70_0044
TipWork3 = Target.TextToDisplay & " " '//#B70_0044
Dim TipWork4 As String '//#B76_0049
TipWork4 = Target.TextToDisplay & " " '//#B76_0049
Dim TipWork5 As String '//#B76_0049
TipWork5 = Target.TextToDisplay & " " '//#B76_0049
Dim nAddressFlag As Integer '//#B76_0049
nAddressFlag = 0 '//#B76_0049
If Target.ScreenTip = TipWork Then '//#B67_0180
nURLAddFlag = 1 '//#B67_0180
ElseIf Target.ScreenTip = TipWork2 Then '//#B70_0044
nURLAddFlag = 2 '//#B70_0044
ElseIf Target.ScreenTip = TipWork3 Then '//#B70_0044
nURLAddFlag = 3 '//#B70_0044
ElseIf Target.ScreenTip = TipWork4 Then '//#B76_0049
nAddressFlag = 1 '//#B76_0049
ElseIf Target.ScreenTip = TipWork5 Then '//#B76_0049
nAddressFlag = 2 '//#B76_0049
End If '//#B67_0180
If nAddressFlag = 0 Then '//#B76_0049
Address = ReplaceFunc(InfoSheetOBJ.Range("SYS_KOUHOU_URL").Value, "{0}", URLEncode(Address)) '//#B60_0190'//#B76_0049
ElseIf nAddressFlag = 1 Then '//#B76_0049
Address = ReplaceFunc(InfoSheetOBJ.Range("SYS_ZENBUN_URL").Value, "{0}", URLEncode(Address)) '//#B76_0049
ElseIf nAddressFlag = 2 Then '//#B76_0049
Address = ReplaceFunc(InfoSheetOBJ.Range("SYS_PDF_URL").Value, "{0}", URLEncode(Address)) '//#B76_0049
End If '//#B76_0049
If nURLAddFlag = 1 Then '//#B65_0009
Address = Address + "&Type=1" '//#B65_0009
ElseIf nURLAddFlag = 2 Then '//#B70_0044
Address = Address + "&KoukaiFlag=1" '//#B70_0044
ElseIf nURLAddFlag = 3 Then '//#B70_0044
Address = Address + "&TourokuFlag=1" '//#B70_0044
End If '//#B65_0009
On Error GoTo IE_ERROR
RETRY_NAVI:
Dim strRegValue As String '/*B0200_3001*/
' クライアントマシンの既定のブラウザ情報を取得 '/*B0200_3001*/
strRegValue = GetBrowserInfo() '/*B0200_3001*/
If (InStr(strRegValue, "Chrome") > 0) Then '/*B0200_3001*/
'Chrome で開く '/*B0200_3001*/
Dim wShell As Object '/*B0200_3001*/
Set wShell = CreateObject("WScript.Shell") '/*B0200_3001*/
wShell.Run (Address) '/*B0200_3001*/
Set wShell = Nothing '/*B0200_3001*/
Else '/*B0200_3001*/
If g_IEOBJ Is Nothing Then '/*B0200_3001*/
Set g_IEOBJ = CreateObject("InternetExplorer.application") '/*B0200_3001*/
End If '/*B0200_3001*/
g_IEOBJ.Navigate Address '//#B60_0190 '/*B0200_3001*/
g_IEOBJ.Visible = True '/*B0200_3001*/
On Error Resume Next '//#B81_0015 '/*B0200_3001*/
Call SetForegroundWindow(g_IEOBJ.hWnd) '//#B40_0020 '/*B0200_3001*/
Call OpenIcon(g_IEOBJ.hWnd) '//#B40_0020 '/*B0200_3001*/
On Error GoTo 0 '//#B81_0015 '/*B0200_3001*/
End If '/*B0200_3001*/
Exit Sub
IE_ERROR:
MsgBox2 g_InfoSheetOBJ.Range("公報表示時にエラーが発生しました").Value & "(" & Err.Description & ")" '//#B87_0242
Err.Clear
End Sub
'IEのQuitイベント取得処理
'//#B31_0022
Public Sub g_IEOBJ_OnQuit()
Set g_IEOBJ = Nothing
End Sub
'全一括表示ボタンイベント
'//#B40_0020
Public Sub SyourokuDispBtn_Click() '//#B60_0138
Dim Address As String
Dim InfoSheetOBJ As Worksheet
Dim ErrMsg As String
On Error GoTo IE_ERROR
HeaderRangeInit
Set InfoSheetOBJ = Worksheets("INFO")
'公報番号一覧ファイル作成
If GetRangeOBJ(g_KouhouNO_RangeName) Is Nothing Then
MsgBox2 g_InfoSheetOBJ.Range("公報番号情報が存在しません").Value '//#B87_0242
Exit Sub
End If
Dim FileNamePath As String
Dim FileName As String
FileNamePath = GetTMPPath()
If FileNamePath = "" Then
Exit Sub
End If
FileName = MakeFileName()
FileNamePath = FileNamePath & "\" & FileName
If MakeKouhouFile(FileNamePath) = False Then
Exit Sub
End If
'URLアドレス作成
Address = ReplaceFunc(InfoSheetOBJ.Range("SYS_SYOUROKU_URL").Value, "{0}", FileName)
Address = ReplaceFunc(Address, "{1}", "0") '//#B60_0138
Address = ReplaceFunc(Address, "{2}", InfoSheetOBJ.Range("SYS_DOWNLOAD_USERID").Value) '//#B87_0113
Address = ReplaceFunc(Address, "{3}", InfoSheetOBJ.Range("SYS_DOWNLOAD_USERID").Value)
RETRY_NAVI:
Dim strUser As String '/*B0200_3003*/
Dim strServerName As String '/*B0200_3003*/
Dim strCSVUploadUrl As String '/*B0200_3003*/
Dim strRegValue As String '/*B0200_3003*/
' CSVファイルアップロード(オフライン連続抄録) '/*B0200_3003*/
strCSVUploadUrl = InfoSheetOBJ.Range("SYS_SYOUROKU_CSV_URL").Value '/*B0200_3003*/
strUser = InfoSheetOBJ.Range("SYS_DOWNLOAD_USERID").Value '/*B0200_3003*/
If (FileUpload(strCSVUploadUrl, FileNamePath, strUser) = -1) Then '/*B0200_3003*/
Exit Sub '/*B0200_3003*/
End If '/*B0200_3003*/
' クライアントマシンの既定のブラウザ情報を取得 '/*B0200_3003*/
strRegValue = GetBrowserInfo() '/*B0200_3003*/
If (InStr(strRegValue, "Chrome") > 0) Then '/*B0200_3003*/
'Chrome で開く '/*B0200_3003*/
Dim wShell As Object '/*B0200_3003*/
Set wShell = CreateObject("WScript.Shell") '/*B0200_3003*/
wShell.Run (Address) '/*B0200_3003*/
Set wShell = Nothing '/*B0200_3003*/
Else '/*B0200_3003*/
If g_IEOBJ Is Nothing Then '/*B0200_3003*/
Set g_IEOBJ = CreateObject("InternetExplorer.application") '/*B0200_3003*/
End If '/*B0200_3003*/
g_IEOBJ.Navigate Address '//#B60_0190 '/*B0200_3003*/
g_IEOBJ.Visible = True '/*B0200_3003*/
On Error Resume Next '//#B81_0015 '/*B0200_3003*/
Call SetForegroundWindow(g_IEOBJ.hWnd) '//#B40_0020 '/*B0200_3003*/
Call OpenIcon(g_IEOBJ.hWnd) '//#B40_0020 '/*B0200_3003*/
On Error GoTo 0 '//#B81_0015 '/*B0200_3003*/
End If '/*B0200_3003*/
Exit Sub
IE_ERROR:
MsgBox2 g_InfoSheetOBJ.Range("全一括表示時にエラーが発生しました").Value & "(" & Err.Description & ")" '//#B87_0242
Err.Clear
End Sub
'IEのQuitイベント取得処理
'//#B40_0020
Public Sub g_SyourokuIEOBJ_OnQuit()
Set g_SyourokuIEOBJ = Nothing
End Sub
'公報番号一覧ファイル作成
'//#B40_0020
Public Function MakeKouhouFile(FileNamePath As String) As Boolean
Dim strCSVLineData As String
Dim StartRowPos As Long
Dim StartColPos As Long
Dim ColNum As Long
Dim RowNum As Long
Dim RowPos As Long
Dim ColPos As Long
Dim Num As Long
Dim UploadDataSheetOBJ As Worksheet
Dim UploadSheetOBJ As Worksheet
MakeKouhouFile = False
StartRowPos = Range(g_KouhouNO_RangeName).Row + 1
StartColPos = Range(g_KouhouNO_RangeName).Column
'データチェック
If Cells(StartRowPos, StartColPos).Value = "" Then
MsgBox2 g_InfoSheetOBJ.Range("公報番号のデータが設定されていません").Value '//#B87_0242
Exit Function
End If
'ファイルオープン
Dim FileNumber As Long
FileNumber = FreeFile
Open FileNamePath For Output As #FileNumber
On Error GoTo ERROR_LABEL
'データ出力
RowPos = StartRowPos
ColPos = StartColPos
RowNum = 0
Do While Cells(RowPos, ColPos).Value <> ""
'データ出力
Print #FileNumber, MakeCSVData(Cells(RowPos, ColPos).Value, False)
RowPos = RowPos + 1
Loop
Close #FileNumber
MakeKouhouFile = True
Exit Function
ERROR_LABEL:
Close #FileNumber
Kill FileNamePath
MsgBox2 g_InfoSheetOBJ.Range("公報番号一覧ファイル作成中にエラーが発生しました").Value & "(" & Err.Description & ")" '//#B87_0242
Exit Function
End Function
'更新アップロードボタンイベント
'//#B40_0025
Public Sub UpdateUploadBtn_Click() '#B60_0138
Call UploadFunc(True)
End Sub
'文献アップロードボタンイベント
'//#B40_0025
Public Sub NewUploadBtn_Click() '#B60_0138
Call UploadFunc(False)
End Sub
'アップロード処理
'//#B40_0025
Public Function UploadFunc(UpdateFlag As Boolean)
Dim Address As String
Dim InfoSheetOBJ As Worksheet
Dim ErrMsg As String
Dim MemoWriteFlag As Boolean
Dim HyoukaDBWriteFlag As Boolean '//#B60_0125
Dim ProjectClassWriteFlag As Boolean '//#B68_0034
On Error GoTo IE_ERROR
HeaderRangeInit
Set InfoSheetOBJ = Worksheets("INFO")
'公報番号一覧ファイル作成
If GetRangeOBJ(g_KouhouNO_RangeName) Is Nothing Then
MsgBox2 g_InfoSheetOBJ.Range("公報番号情報が存在しません").Value '//#B87_0242
Exit Function
End If
Dim FileNamePath As String
Dim FileName As String
FileNamePath = GetTMPPath()
If FileNamePath = "" Then
Exit Function
End If
FileName = MakeFileName()
FileNamePath = FileNamePath & "\" & FileName
MemoWriteFlag = False
HyoukaDBWriteFlag = False '//#B60_0125
ProjectClassWriteFlag = False '//#B68_0034
If MakeUploadFile(FileNamePath, UpdateFlag, MemoWriteFlag, HyoukaDBWriteFlag, ProjectClassWriteFlag) = False Then '//#B60_0125//#B68_0034
Exit Function
End If
'URLアドレス作成
Address = InfoSheetOBJ.Range("SYS_UPLOAD_URL").Value
Dim QuerySep As String '//#B76_0012
If InStr(Address, "?") <> 0 Then '//#B76_0012
QuerySep = "&" '//#B76_0012
Else '//#B76_0012
QuerySep = "?" '//#B76_0012
End If '//#B76_0012
Address = Address & QuerySep & "FileName=" & InfoSheetOBJ.Range("SYS_DOWNLOAD_USERID").Value & "_" & FileName '//#B76_0012 '/*B0200_3001*/
Address = Address & "&UserID=" & InfoSheetOBJ.Range("SYS_DOWNLOAD_USERID").Value
If UpdateFlag = True Then
Address = Address & "&Update=1"
End If
If MemoWriteFlag = False Then
Address = Address & "&MemoNon=1"
End If
If HyoukaDBWriteFlag = False Then '//#B60_0125
Address = Address & "&HyoukaDBNon=1" '//#B60_0125
End If '//#B60_0125
If ProjectClassWriteFlag = False Then '//#B68_0034
Address = Address & "&ProjectClassNon=1" '//#B68_0034
End If '//#B68_0034
If InfoSheetOBJ.Range("SYS_USERIDADDFLAG").Value = 2 Then
Address = Address & "&NAME=" & URLEncode(InfoSheetOBJ.Range("SYS_USER_NAME").Value) '//#B62_0019
Address = Address & "&ROLEID=" & InfoSheetOBJ.Range("SYS_USER_ROLE").Value
End If
Address = Address & "&ADMINTYPE=" & InfoSheetOBJ.Range("SYS_USER_ADMINTYPE").Value '//#B60_0125
Address = Address & "&UPDATEAUTH=" & InfoSheetOBJ.Range("SYS_USER_UPDATEAUTH").Value '//#B60_0125
Address = Address & "&GROUPID=" & InfoSheetOBJ.Range("SYS_USER_GROUP").Value '//#B60_0125
RETRY_NAVI:
Dim strUser As String '/*B0200_3001*/
Dim strServerName As String '/*B0200_3001*/
Dim strCSVUploadUrl As String '/*B0200_3001*/
Dim strRegValue As String '/*B0200_3001*/
' CSVファイルアップロード(Excelアップロード) '/*B0200_3001*/
strCSVUploadUrl = InfoSheetOBJ.Range("SYS_UPLOAD_CSV_URL").Value '/*B0200_3001*/
strUser = InfoSheetOBJ.Range("SYS_DOWNLOAD_USERID").Value '/*B0200_3001*/
If (FileUpload(strCSVUploadUrl, FileNamePath, strUser) = -1) Then '/*B0200_3001*/
Exit Function '/*B0200_3001*/
End If '/*B0200_3001*/
' クライアントマシンの既定のブラウザ情報を取得 '/*B0200_3001*/
strRegValue = GetBrowserInfo() '/*B0200_3001*/
If (InStr(strRegValue, "Chrome") > 0) Then '/*B0200_3001*/
'Chrome で開く '/*B0200_3001*/
Dim wShell As Object '/*B0200_3001*/
Set wShell = CreateObject("WScript.Shell") '/*B0200_3001*/
wShell.Run (Address) '/*B0200_3001*/
Set wShell = Nothing '/*B0200_3001*/
Else '/*B0200_3001*/
If g_UploadIEOBJ Is Nothing Then '/*B0200_3001*/
Set g_UploadIEOBJ = CreateObject("InternetExplorer.application") '/*B0200_3001*/
End If '/*B0200_3001*/
g_UploadIEOBJ.Navigate Address '/*B0200_3001*/
g_UploadIEOBJ.Visible = True '/*B0200_3001*/
On Error Resume Next '//#B81_0015 '/*B0200_3001*/
Call SetForegroundWindow(g_UploadIEOBJ.hWnd) '/*B0200_3001*/
Call OpenIcon(g_UploadIEOBJ.hWnd) '/*B0200_3001*/
On Error GoTo 0 '//#B81_0015 '/*B0200_3001*/
End If '/*B0200_3001*/
Exit Function
IE_ERROR:
MsgBox2 g_InfoSheetOBJ.Range("アップロード時にエラーが発生しました").Value & "(" & Err.Description & ")" '//#B87_0242
Err.Clear
End Function
'アップロードファイル作成
'//#B40_0025
Public Function MakeUploadFile(FileNamePath As String, UpdateFlag As Boolean, ByRef MemoWriteFlag As Boolean, ByRef HyoukaDBWriteFlag, ByRef ProjectClassWriteFlag) As Boolean '//#B60_0125//#B68_0034
Dim RowPos As Long
Dim nKouhouNoColPos As Long
Dim nHyoukaColPos As Long
Dim nMemo00ColPos As Long
Dim nMemo01ColPos As Long
Dim nMemo02ColPos As Long
Dim nMemo03ColPos As Long
Dim nMemo04ColPos As Long
Dim nMemo05ColPos As Long
Dim nMemo06ColPos As Long
Dim nMemo07ColPos As Long
Dim nMemo08ColPos As Long
Dim nMemo09ColPos As Long
Dim nMemo10ColPos As Long
Dim nYOUYAKUColPos As Long '//#B60_0125
Dim nSEIHINColPos As Long '//#B60_0125
Dim nHYOUKA_DBColPos As Long '//#B60_0125
Dim nHYOUKARIYUColPos As Long '//#B60_0125
Dim nBUNRUI1ColPos As Long '//#B60_0125
Dim nBUNRUI2ColPos As Long '//#B60_0125
Dim nBUNRUI3ColPos As Long '//#B60_0125
Dim nBUNRUI4ColPos As Long '//#B60_0125
Dim nBUNRUI5ColPos As Long '//#B60_0125
Dim nRELATION_GROUPColPos As Long '//#B62_0005
Dim nHYOUKA_COMMENTColPos As Long '//#B62_0005
Dim nKEYWORDColPos As Long '//#B62_0005
Dim nJISYAJOUKYOUColPos As Long '//#B62_0006
Dim nJISYAJOUKYOU_DETAILColPos As Long '//#B62_0006
Dim nTAISAKUANColPos As Long '//#B62_0006
Dim nFREE_ITEM1ColPos As Long '//#B84_0327
Dim nFREE_ITEM2ColPos As Long '//#B84_0327
Dim nFREE_ITEM3ColPos As Long '//#B84_0327
Dim nFREE_ITEM4ColPos As Long '//#B84_0327
Dim nFREE_ITEM5ColPos As Long '//#B84_0327
Dim nPROCBUNRUI1ColPos As Long '//#B67_0009
Dim nPROCBUNRUI2ColPos As Long '//#B67_0009
Dim nPROCBUNRUI3ColPos As Long '//#B67_0009
Dim nPROCBUNRUI4ColPos As Long '//#B67_0009
Dim nPROCBUNRUI5ColPos As Long '//#B67_0009
Dim nUSER_YOUYAKUColPos As Long '//#B67_0009
Dim nUSER_SEIHINColPos As Long '//#B67_0009
Dim nUSER_HYOUKA_DBColPos As Long '//#B67_0009
Dim nUSER_HYOUKARIYUColPos As Long '//#B67_0009
Dim nUSER_BUNRUI1ColPos As Long '//#B67_0009
Dim nUSER_BUNRUI2ColPos As Long '//#B67_0009
Dim nUSER_BUNRUI3ColPos As Long '//#B67_0009
Dim nUSER_BUNRUI4ColPos As Long '//#B67_0009
Dim nUSER_BUNRUI5ColPos As Long '//#B67_0009
Dim nUSER_RELATION_GROUPColPos As Long '//#B67_0009
Dim nUSER_HYOUKA_COMMENTColPos As Long '//#B67_0009
Dim nUSER_KEYWORDColPos As Long '//#B67_0009
Dim nUSER_JISYAJOUKYOUColPos As Long '//#B67_0009
Dim nUSER_JISYAJOUKYOU_DETAILColPos As Long '//#B67_0009
Dim nUSER_TAISAKUANColPos As Long '//#B67_0009
Dim nUSER_FREE_ITEM1ColPos As Long '//#B84_0327
Dim nUSER_FREE_ITEM2ColPos As Long '//#B84_0327
Dim nUSER_FREE_ITEM3ColPos As Long '//#B84_0327
Dim nUSER_FREE_ITEM4ColPos As Long '//#B84_0327
Dim nUSER_FREE_ITEM5ColPos As Long '//#B84_0327
Dim nUSER_PROCBUNRUI1ColPos As Long '//#B67_0009
Dim nUSER_PROCBUNRUI2ColPos As Long '//#B67_0009
Dim nUSER_PROCBUNRUI3ColPos As Long '//#B67_0009
Dim nUSER_PROCBUNRUI4ColPos As Long '//#B67_0009
Dim nUSER_PROCBUNRUI5ColPos As Long '//#B67_0009
Dim nCLASSColPos As Long '//#B68_0034
Dim InfoSheetOBJ As Worksheet
Dim WriteUploadFile As Boolean
Dim wkValue As String '//#B89_0098
MakeUploadFile = False
nKouhouNoColPos = -1
nHyoukaColPos = -1
nMemo00ColPos = -1
nMemo01ColPos = -1
nMemo02ColPos = -1
nMemo03ColPos = -1
nMemo04ColPos = -1
nMemo05ColPos = -1
nMemo06ColPos = -1
nMemo07ColPos = -1
nMemo08ColPos = -1
nMemo09ColPos = -1
nMemo10ColPos = -1
nYOUYAKUColPos = -1 '//#B60_0125
nSEIHINColPos = -1 '//#B60_0125
nHYOUKA_DBColPos = -1 '//#B60_0125
nHYOUKARIYUColPos = -1 '//#B60_0125
nBUNRUI1ColPos = -1 '//#B60_0125
nBUNRUI2ColPos = -1 '//#B60_0125
nBUNRUI3ColPos = -1 '//#B60_0125
nBUNRUI4ColPos = -1 '//#B60_0125
nBUNRUI5ColPos = -1 '//#B60_0125
nRELATION_GROUPColPos = -1 '//#B62_0005
nHYOUKA_COMMENTColPos = -1 '//#B62_0005
nKEYWORDColPos = -1 '//#B62_0005
nJISYAJOUKYOUColPos = -1 '//#B62_0006
nJISYAJOUKYOU_DETAILColPos = -1 '//#B62_0006
nTAISAKUANColPos = -1 '//#B62_0006
nFREE_ITEM1ColPos = -1 '//#B84_0327
nFREE_ITEM2ColPos = -1 '//#B84_0327
nFREE_ITEM3ColPos = -1 '//#B84_0327
nFREE_ITEM4ColPos = -1 '//#B84_0327
nFREE_ITEM5ColPos = -1 '//#B84_0327
nPROCBUNRUI1ColPos = -1 '//#B67_0009
nPROCBUNRUI2ColPos = -1 '//#B67_0009
nPROCBUNRUI3ColPos = -1 '//#B67_0009
nPROCBUNRUI4ColPos = -1 '//#B67_0009
nPROCBUNRUI5ColPos = -1 '//#B67_0009
nUSER_YOUYAKUColPos = -1 '//#B67_0009
nUSER_SEIHINColPos = -1 '//#B67_0009
nUSER_HYOUKA_DBColPos = -1 '//#B67_0009
nUSER_HYOUKARIYUColPos = -1 '//#B67_0009
nUSER_BUNRUI1ColPos = -1 '//#B67_0009
nUSER_BUNRUI2ColPos = -1 '//#B67_0009
nUSER_BUNRUI3ColPos = -1 '//#B67_0009
nUSER_BUNRUI4ColPos = -1 '//#B67_0009
nUSER_BUNRUI5ColPos = -1 '//#B67_0009
nUSER_RELATION_GROUPColPos = -1 '//#B67_0009
nUSER_HYOUKA_COMMENTColPos = -1 '//#B67_0009
nUSER_KEYWORDColPos = -1 '//#B67_0009
nUSER_JISYAJOUKYOUColPos = -1 '//#B67_0009
nUSER_JISYAJOUKYOU_DETAILColPos = -1 '//#B67_0009
nUSER_TAISAKUANColPos = -1 '//#B67_0009
nUSER_FREE_ITEM1ColPos = -1 '//#B84_0327
nUSER_FREE_ITEM2ColPos = -1 '//#B84_0327
nUSER_FREE_ITEM3ColPos = -1 '//#B84_0327
nUSER_FREE_ITEM4ColPos = -1 '//#B84_0327
nUSER_FREE_ITEM5ColPos = -1 '//#B84_0327
nUSER_PROCBUNRUI1ColPos = -1 '//#B67_0009
nUSER_PROCBUNRUI2ColPos = -1 '//#B67_0009
nUSER_PROCBUNRUI3ColPos = -1 '//#B67_0009
nUSER_PROCBUNRUI4ColPos = -1 '//#B67_0009
nUSER_PROCBUNRUI5ColPos = -1 '//#B67_0009
nCLASSColPos = -1 '//#B68_0034
WriteUploadFile = False
MemoWriteFlag = False
HyoukaDBWriteFlag = False '//#B60_0125
ProjectClassWriteFlag = False '//#B68_0034
Set InfoSheetOBJ = Worksheets("INFO")
'ファイルオープン
Dim UTF8_Flag As String '//#B80_0142
UTF8_Flag = InfoSheetOBJ.Range("SYS_UTF8_FLAG").Value '//#B80_0142
If OpenText(FileNamePath, UTF8_Flag) = -1 Then '//#B80_0142
GoTo ERROR_LABEL '//#B80_0142
End If '//#B80_0142
On Error GoTo ERROR_LABEL
'PROJECT_CODE
PutTextData "PROJECT_CODE," & MakeCSVData(InfoSheetOBJ.Range("SYS_PROJECT_CODE").Value, True) & "," '//#B67_0009'//#B80_0142
'PROJECT_TITLE
PutTextData "PROJECT_TITLE," & MakeCSVData(InfoSheetOBJ.Range("SYS_PROJECT_TITLE").Value, True) & "," '//#B67_0009'//#B80_0142
'DOWNLOAD_USERID
PutTextData "DOWNLOAD_USERID," & MakeCSVData(InfoSheetOBJ.Range("SYS_DOWNLOAD_USERID").Value, False) & "," '//#B80_0142
'RIREKI_TYPE
PutTextData "RIREKI_TYPE," & MakeCSVData(InfoSheetOBJ.Range("SYS_RIREKI_TYPE").Value, False) & "," '//#B80_0142
'RIREKI_FILENAME
PutTextData "RIREKI_FILENAME," & MakeCSVData(InfoSheetOBJ.Range("SYS_RIREKI_FILENAME").Value, False) & "," '//#B80_0142
'SEARCH_USERID
PutTextData "SEARCH_USERID," & MakeCSVData(InfoSheetOBJ.Range("SYS_SEARCH_USERID").Value, False) & "," '//#B80_0142
'SEARCH_DATE
PutTextData "SEARCH_DATE," & MakeCSVData(InfoSheetOBJ.Range("SYS_SEARCH_DATE").Value, False) & "," '//#B80_0142
'SEARCH_DATA
PutTextData "SEARCH_DATA," & MakeCSVData(InfoSheetOBJ.Range("SYS_SEARCH_DATA").Value, True) & "," '//#B80_0142
'TITLE
PutTextData "TITLE," & MakeCSVData(Sheet4.GetText("TitleText"), True) & "," '//#B60_0138 '//#B80_0142 '//#B88_0041
'COMMENT
PutTextData "COMMENT," & MakeCSVData(Sheet4.GetText("CommentText"), True) & "," '//#B60_0138'//#B80_0142 '//#B88_0041
'データ
'公報番号情報取得
RowPos = Range(g_KouhouNO_RangeName).Row + 1
nKouhouNoColPos = Range(g_KouhouNO_RangeName).Column
'評価位置取得
If Not GetRangeOBJ(g_Hyouka_RangeName) Is Nothing Then
If Sheet1.CheckBoxes.Item(g_Hyouka_RangeName & "_BTN").Value = 1 Then '//#B87_0221 '//#B88_0041
nHyoukaColPos = Range(g_Hyouka_RangeName).Column
End If
End If
'メモの内容位置取得
If Not GetRangeOBJ(g_Memo00_RangeName) Is Nothing Then
If Sheet1.CheckBoxes.Item(g_Memo00_RangeName & "_BTN").Value = 1 Then '//#B87_0221 '//#B88_0041
nMemo00ColPos = Range(g_Memo00_RangeName).Column
End If
End If
'社内分類1位置取得
If Not GetRangeOBJ(g_Memo01_RangeName) Is Nothing Then
If Sheet1.CheckBoxes.Item(g_Memo01_RangeName & "_BTN").Value = 1 Then '//#B87_0221 '//#B88_0041
nMemo01ColPos = Range(g_Memo01_RangeName).Column
End If
End If
'社内分類2位置取得
If Not GetRangeOBJ(g_Memo02_RangeName) Is Nothing Then
If Sheet1.CheckBoxes.Item(g_Memo02_RangeName & "_BTN").Value = 1 Then '//#B87_0221 '//#B88_0041
nMemo02ColPos = Range(g_Memo02_RangeName).Column
End If
End If
'社内分類3位置取得
If Not GetRangeOBJ(g_Memo03_RangeName) Is Nothing Then
If Sheet1.CheckBoxes.Item(g_Memo03_RangeName & "_BTN").Value = 1 Then '//#B87_0221 '//#B88_0041
nMemo03ColPos = Range(g_Memo03_RangeName).Column
End If
End If
'社内分類4位置取得
If Not GetRangeOBJ(g_Memo04_RangeName) Is Nothing Then
If Sheet1.CheckBoxes.Item(g_Memo04_RangeName & "_BTN").Value = 1 Then '//#B87_0221 '//#B88_0041
nMemo04ColPos = Range(g_Memo04_RangeName).Column
End If
End If
'社内分類5位置取得
If Not GetRangeOBJ(g_Memo05_RangeName) Is Nothing Then
If Sheet1.CheckBoxes.Item(g_Memo05_RangeName & "_BTN").Value = 1 Then '//#B87_0221 '//#B88_0041
nMemo05ColPos = Range(g_Memo05_RangeName).Column
End If
End If
'社内分類6位置取得
If Not GetRangeOBJ(g_Memo06_RangeName) Is Nothing Then
If Sheet1.CheckBoxes.Item(g_Memo06_RangeName & "_BTN").Value = 1 Then '//#B87_0221 '//#B88_0041
nMemo06ColPos = Range(g_Memo06_RangeName).Column
End If
End If
'社内分類7位置取得
If Not GetRangeOBJ(g_Memo07_RangeName) Is Nothing Then
If Sheet1.CheckBoxes.Item(g_Memo07_RangeName & "_BTN").Value = 1 Then '//#B87_0221 '//#B88_0041
nMemo07ColPos = Range(g_Memo07_RangeName).Column
End If
End If
'社内分類8位置取得
If Not GetRangeOBJ(g_Memo08_RangeName) Is Nothing Then
If Sheet1.CheckBoxes.Item(g_Memo08_RangeName & "_BTN").Value = 1 Then '//#B87_0221 '//#B88_0041
nMemo08ColPos = Range(g_Memo08_RangeName).Column
End If
End If
'社内分類9位置取得
If Not GetRangeOBJ(g_Memo09_RangeName) Is Nothing Then
If Sheet1.CheckBoxes.Item(g_Memo09_RangeName & "_BTN").Value = 1 Then '//#B87_0221 '//#B88_0041
nMemo09ColPos = Range(g_Memo09_RangeName).Column
End If
End If
'社内分類10位置取得
If Not GetRangeOBJ(g_Memo10_RangeName) Is Nothing Then
If Sheet1.CheckBoxes.Item(g_Memo10_RangeName & "_BTN").Value = 1 Then '//#B87_0221 '//#B88_0041
nMemo10ColPos = Range(g_Memo10_RangeName).Column
End If
End If
'評価者要約位置取得 '//#B60_0125
If Not GetRangeOBJ(g_YOUYAKU_RangeName) Is Nothing Then '//#B60_0125
If Sheet1.CheckBoxes.Item(g_YOUYAKU_RangeName & "_BTN").Value = 1 Then '//#B60_0125 '//#B87_0221 '//#B88_0041
nYOUYAKUColPos = Range(g_YOUYAKU_RangeName).Column '//#B60_0125
End If '//#B60_0125
End If '//#B60_0125
'対象製品位置取得 '//#B60_0125
If Not GetRangeOBJ(g_SEIHIN_RangeName) Is Nothing Then '//#B60_0125
…
|
|||
vbaProject_00.bin |
vba-project | OOXML VBA project: xl/vbaProject.bin | 288768 bytes |
SHA-256: 92fc0d7e45810b9d36f1891854c97896d5bafbbf7772a078ff6ecd469abb4793 |
|||
Open this report in the interactive analyzer, or submit your own file for analysis.