{"id":7240,"date":"2016-08-25T13:46:30","date_gmt":"2016-08-25T04:46:30","guid":{"rendered":"https:\/\/www.ka-net.org\/blog\/?p=7240"},"modified":"2016-08-25T13:46:30","modified_gmt":"2016-08-25T04:46:30","slug":"office%e3%83%95%e3%82%a1%e3%82%a4%e3%83%ab%e3%81%8b%e3%82%89%e4%bd%9c%e6%88%90%e8%80%85%e3%81%aa%e3%81%a9%e3%81%ae%e3%83%97%e3%83%ad%e3%83%91%e3%83%86%e3%82%a3%e3%82%92%e5%8f%96%e5%be%97%e3%81%99","status":"publish","type":"post","link":"https:\/\/www.ka-net.org\/blog\/?p=7240","title":{"rendered":"Office\u30d5\u30a1\u30a4\u30eb\u304b\u3089\u4f5c\u6210\u8005\u306a\u3069\u306e\u30d7\u30ed\u30d1\u30c6\u30a3\u3092\u53d6\u5f97\u3059\u308bVBScript"},"content":{"rendered":"

\u4e0b\u8a18\u8a18\u4e8b\u3067\u3082\u66f8\u3044\u3066\u3044\u307e\u3059\u304c\u3001xlsx\u3084docx\u3068\u3044\u3063\u305f\u3001OOXML\u5f62\u5f0f\u306eOffice\u30d5\u30a1\u30a4\u30eb\u3092ZIP\u89e3\u51cd\u3059\u308b\u3068\u3001\u4e2d\u306b\u3042\u308bXML\u30d5\u30a1\u30a4\u30eb\u304b\u3089\u69d8\u3005\u306a\u60c5\u5831\u3092\u53d6\u5f97\u3059\u308b\u3053\u3068\u304c\u3067\u304d\u307e\u3059\u3002<\/p>\n

\u300cExcel VBA\u306e\u795e\u69d8 \u30dc\u30af\u306e\u4eba\u751f\u3092\u5909\u3048\u3066\u304f\u308c\u305f\u4eba\u300d(\u5927\u6751\u3042\u3064\u3057\u8457)\u30ec\u30d3\u30e5\u30fc<\/a><\/div>
2015.10.07<\/span>
\u300cExcel VBA\u306e\u795e\u69d8 \u30dc\u30af\u306e\u4eba\u751f\u3092\u5909\u3048\u3066\u304f\u308c\u305f\u4eba\u300d(\u5927\u6751\u3042\u3064\u3057\u8457)\u30ec\u30d3\u30e5\u30fc <\/a><\/div>
\u203b \u4e0b\u8a18\u30ec\u30d3\u30e5\u30fc\u306f\u3042\u304f\u307e\u3067\u3082\u500b\u4eba\u7684\u306a\u611f\u60f3\u3067\u3059\u3002\r\n\r\n\r\n2015\u5e749\u670829\u65e5\u767a\u58f2\u306e\u300cExcel VBA\u306e\u795e\u69d8 \u30dc\u30af\u306e\u4eba\u751f\u3092\u5909\u3048\u3066\u304f\u308c\u305f\u4eba\u300d(\u79c0\u548c\u30b7\u30b9\u30c6\u30e0\u51fa\u7248)\u3092\u3055\u3063\u305d\u304f\u8cfc\u5165\u3057\u3066\u304d\u307e\u3057\u305f\u3002\r\n\r\n\r\n\r\n\r\n\r\n\u4f5c\u8005\u306fOffice(VBA)\u754c\u9688\u3067\u306f\u77e5\u3089\u306a\u3044\u4eba\u306f...<\/div><\/div>
<\/div><\/div>\n

\u30d5\u30a1\u30a4\u30eb\u6570\u304c\u5c11\u306a\u3051\u308c\u3070\u7279\u306b\u554f\u984c\u306f\u7121\u3044\u306e\u3067\u3059\u304c\u3001\u30d5\u30a1\u30a4\u30eb\u6570\u304c\u591a\u3044\u3068\u304d\u3001\u3044\u3061\u3044\u3061\u89e3\u51cd\u3057\u3066\u30d5\u30a1\u30a4\u30eb\u3092\u63a2\u3057\u3066\u30c6\u30ad\u30b9\u30c8\u30a8\u30c7\u30a3\u30bf\u3067\u958b\u3044\u3066\u2026\u3068\u3044\u3046\u306e\u306f\u5c11\u3005\u9762\u5012\u81ed\u304f\u611f\u3058\u307e\u3059\u3002<\/p>\n

\u305d\u3053\u3067\u3001\u30c9\u30e9\u30c3\u30b0\uff06\u30c9\u30ed\u30c3\u30d7\u3059\u308b\u3060\u3051\u3067\u30d5\u30a1\u30a4\u30eb\u306e\u60c5\u5831\u3092\u53d6\u5f97\u3067\u304d\u308b\u3088\u3046\u3001\u30b9\u30af\u30ea\u30d7\u30c8\u3092\u66f8\u304f\u3053\u3068\u306b\u3057\u307e\u3057\u305f\u3002<\/p>\n

Option Explicit\r\n\r\nDim Args\r\n\r\nSet Args = WScript.Arguments\r\nIf Args.Count < 1 Then\r\n  MsgBox "Office\u30d5\u30a1\u30a4\u30eb\u3092\u5f53\u30b9\u30af\u30ea\u30d7\u30c8\u30d5\u30a1\u30a4\u30eb\u306b\u30c9\u30e9\u30c3\u30b0\uff06\u30c9\u30ed\u30c3\u30d7\u3057\u3066\u304f\u3060\u3055\u3044\u3002", vbExclamation + vbSystemModal\r\n  WScript.Quit\r\nEnd If\r\nGetOpenXMLInfo Args(0)\r\n\r\nPrivate Sub GetOpenXMLInfo(ByVal TargetFilePath)\r\n  Dim TmpFolderName\r\n  Dim TmpFolderPath\r\n  Dim TmpFileName\r\n  Dim TmpFilePath\r\n  Dim DpFolderPath\r\n  Dim AppFilePath\r\n  Dim CoreFilePath\r\n  Dim AppVersion\r\n  Dim dc_creator\r\n  Dim cp_lastModifiedBy\r\n  Dim dcterms_created\r\n  Dim dcterms_modified\r\n  Dim d1, d2\r\n  Const dp = "docProps"\r\n  Const app = "app.xml"\r\n  Const core = "core.xml"\r\n    \r\n  '\u4f5c\u696d\u7528\u30d5\u30a9\u30eb\u30c0\u4f5c\u6210\u30fb\u4f5c\u696d\u7528\u30d5\u30a1\u30a4\u30eb(zip)\u30b3\u30d4\u30fc\r\n  TmpFolderName = Replace(Now(), "\/", "")\r\n  TmpFolderName = Replace(TmpFolderName, ":", "")\r\n  TmpFolderName = Replace(TmpFolderName, " ", "")\r\n  TmpFolderName = "tmp_" & TmpFolderName\r\n  With CreateObject("Scripting.FileSystemObject")\r\n    TmpFolderPath = AddPathSeparator(.GetFile(TargetFilePath).ParentFolder.Path) & _\r\n                    TmpFolderName\r\n    If .FolderExists(TmpFolderPath) = True Then\r\n      MsgBox "\u4f5c\u696d\u7528\u30d5\u30a9\u30eb\u30c0\u304c\u3059\u3067\u306b\u5b58\u5728\u3057\u3066\u3044\u307e\u3059\u3002" & vbNewLine & _\r\n             "\u51e6\u7406\u3092\u4e2d\u6b62\u3057\u307e\u3059\u3002", vbExclamation + vbSystemModal\r\n      Exit Sub\r\n    End If\r\n    .CreateFolder TmpFolderPath\r\n    TmpFileName = .GetBaseName(.GetFile(TargetFilePath)) & ".zip"\r\n    TmpFilePath = AddPathSeparator(TmpFolderPath) & TmpFileName\r\n    .CopyFile TargetFilePath, TmpFilePath, True\r\n  End With\r\n  \r\n  'zip\u30d5\u30a1\u30a4\u30eb\u304b\u3089[docProps]\u30d5\u30a9\u30eb\u30c0\u3092\u30b3\u30d4\u30fc\r\n  With CreateObject("Shell.Application")\r\n    .Namespace(TmpFolderPath).CopyHere .Namespace(TmpFilePath).Items.Item(dp)\r\n  End With\r\n  \r\n  'xml\u30d5\u30a1\u30a4\u30eb\u306e\u30d1\u30b9\u53d6\u5f97\r\n  With CreateObject("Scripting.FileSystemObject")\r\n    DpFolderPath = AddPathSeparator(TmpFolderPath) & dp\r\n    If .FolderExists(DpFolderPath) = False Then\r\n      MsgBox "[docProps]\u30d5\u30a9\u30eb\u30c0\u304c\u898b\u3064\u304b\u308a\u307e\u305b\u3093\u3067\u3057\u305f\u3002" & vbNewLine & _\r\n             "\u51e6\u7406\u3092\u4e2d\u6b62\u3057\u307e\u3059\u3002", vbExclamation + vbSystemModal\r\n      DelFolder TmpFolderPath\r\n      Exit Sub\r\n    End If\r\n    AppFilePath = AddPathSeparator(DpFolderPath) & app\r\n    CoreFilePath = AddPathSeparator(DpFolderPath) & core\r\n    If (.FileExists(AppFilePath) = False) Or _\r\n       (.FileExists(CoreFilePath) = False) Then\r\n      MsgBox "XML\u30d5\u30a1\u30a4\u30eb\u304c\u898b\u3064\u304b\u308a\u307e\u305b\u3093\u3067\u3057\u305f\u3002" & vbNewLine & _\r\n             "\u51e6\u7406\u3092\u4e2d\u6b62\u3057\u307e\u3059\u3002", vbExclamation + vbSystemModal\r\n      DelFolder TmpFolderPath\r\n      Exit Sub\r\n    End If\r\n  End With\r\n  \r\n  'xml\u30d5\u30a1\u30a4\u30eb\u304b\u3089\u5024\u3092\u53d6\u5f97\r\n  With CreateObject("MSXML2.DOMDocument")\r\n    .async = False\r\n    If .Load(AppFilePath) = False Then\r\n      MsgBox app & "\u30d5\u30a1\u30a4\u30eb\u306e\u8aad\u307f\u8fbc\u307f\u306b\u5931\u6557\u3057\u307e\u3057\u305f\u3002" & vbNewLine & _\r\n             "\u51e6\u7406\u3092\u4e2d\u6b62\u3057\u307e\u3059\u3002", vbExclamation + vbSystemModal\r\n      DelFolder TmpFolderPath\r\n      Exit Sub\r\n    End If\r\n    On Error Resume Next\r\n    AppVersion = .SelectSingleNode("\/Properties\/AppVersion").Text\r\n    On Error GoTo 0\r\n    If .Load(CoreFilePath) = False Then\r\n      MsgBox core & "\u30d5\u30a1\u30a4\u30eb\u306e\u8aad\u307f\u8fbc\u307f\u306b\u5931\u6557\u3057\u307e\u3057\u305f\u3002" & vbNewLine & _\r\n             "\u51e6\u7406\u3092\u4e2d\u6b62\u3057\u307e\u3059\u3002", vbExclamation + vbSystemModal\r\n      DelFolder TmpFolderPath\r\n      Exit Sub\r\n    End If\r\n    On Error Resume Next\r\n    dc_creator = .SelectSingleNode("\/cp:coreProperties\/dc:creator").Text\r\n    cp_lastModifiedBy = .SelectSingleNode("\/cp:coreProperties\/cp:lastModifiedBy").Text\r\n    dcterms_created = .SelectSingleNode("\/cp:coreProperties\/dcterms:created").Text\r\n    d1 = Replace(dcterms_created, "T", " ")\r\n    d1 = Replace(d1, "Z", "")\r\n    dcterms_modified = .SelectSingleNode("\/cp:coreProperties\/dcterms:modified").Text\r\n    d2 = Replace(dcterms_modified, "T", " ")\r\n    d2 = Replace(d2, "Z", "")\r\n    On Error GoTo 0\r\n  End With\r\n  DelFolder TmpFolderPath\r\n  \r\n  '\u7d50\u679c\u8868\u793a\r\n  MsgBox "File:" & TargetFilePath & vbNewLine & _\r\n         "AppVersion:" & AppVersion & vbNewLine & _\r\n         "dc:creator:" & dc_creator & vbNewLine & _\r\n         "cp:lastModifiedBy:" & cp_lastModifiedBy & vbNewLine & _\r\n         "dcterms:created:" & dcterms_created & "(" & DateAdd("h", 9, CDate(d1)) & ")" & vbNewLine & _\r\n         "dcterms:modified:" & dcterms_modified & "(" & DateAdd("h", 9, CDate(d2)) & ")", vbInformation + vbSystemModal\r\nEnd Sub\r\n\r\nPrivate Sub DelFolder(ByVal TargetFolderPath)\r\n  With CreateObject("Scripting.FileSystemObject")\r\n    .DeleteFolder TargetFolderPath, True\r\n  End With\r\nEnd Sub\r\n\r\nPrivate Function AddPathSeparator(ByVal s)\r\n  If Right(s, 1) <> ChrW(92) Then s = s & ChrW(92)\r\n  AddPathSeparator = s\r\nEnd Function<\/pre>\n
\u4e0a\u8a18\u30b3\u30fc\u30c9\u3092vbs\u30d5\u30a1\u30a4\u30eb\u3068\u3057\u3066\u4fdd\u5b58\u3057\u305f\u5f8c\u3001Office\u30d5\u30a1\u30a4\u30eb\u3092\u30c9\u30e9\u30c3\u30b0\uff06\u30c9\u30ed\u30c3\u30d7\u3059\u308b\u3068\u3001\u30d5\u30a1\u30a4\u30eb\u3092\u4f5c\u6210\u3057\u305f\u30a2\u30d7\u30ea\u30b1\u30fc\u30b7\u30e7\u30f3\u306e\u30d0\u30fc\u30b8\u30e7\u30f3\u3084\u4f5c\u6210\u8005\u3001\u66f4\u65b0\u65e5\u6642\u3068\u3044\u3063\u305f\u60c5\u5831\u304c\u30e1\u30c3\u30bb\u30fc\u30b8\u30dc\u30c3\u30af\u30b9\u3067\u8868\u793a\u3055\u308c\u307e\u3059\u3002<\/p>\n
\"GetOpenXMLInfo_01\"<\/p>\n
\"GetOpenXMLInfo_02\"<\/p>\n
\u30d5\u30a1\u30a4\u30eb\u306e\u60c5\u5831\u304c\u5206\u304b\u3063\u305f\u304b\u3089\u3068\u3044\u3063\u3066\u3069\u3046\u3068\u3044\u3046\u3053\u3068\u3082\u306a\u3044\u306e\u3067\u3059\u304c\u3001\u4e0a\u8a18\u30b3\u30fc\u30c9\u3092\u5fdc\u7528\u3059\u308b\u3068\u3001Office\u30d5\u30a1\u30a4\u30eb\u306b\u542b\u307e\u308c\u308b\u753b\u50cf\u30d5\u30a1\u30a4\u30eb\u3092\u629c\u304d\u51fa\u3057\u305f\u308a\u3001\u306a\u3093\u3066\u3053\u3068\u3082\u3067\u304d\u308b\u304b\u3068\u601d\u3044\u307e\u3059\u3002<\/p>\n","protected":false},"excerpt":{"rendered":"\u4e0b\u8a18\u8a18\u4e8b\u3067\u3082\u66f8\u3044\u3066\u3044\u307e\u3059\u304c\u3001xlsx\u3084docx\u3068\u3044\u3063\u305f\u3001OOXML\u5f62\u5f0f\u306eOffice\u30d5\u30a1\u30a4\u30eb\u3092ZIP\u89e3\u51cd\u3059\u308b\u3068\u3001\u4e2d\u306b\u3042\u308bXML\u30d5\u30a1\u30a4\u30eb\u304b\u3089\u69d8\u3005\u306a\u60c5\u5831\u3092\u53d6\u5f97\u3059\u308b\u3053\u3068\u304c\u3067\u304d\u307e\u3059\u3002 \u30d5\u30a1\u30a4\u30eb\u6570\u304c\u5c11\u306a\u3051\u308c\u3070\u7279\u306b\u554f\u984c\u306f\u7121\u3044\u306e\u3067\u3059\u304c […]","protected":false},"author":1,"featured_media":7132,"comment_status":"open","ping_status":"closed","sticky":false,"template":"","format":"standard","meta":{"_jetpack_memberships_contains_paid_content":false,"footnotes":"","jetpack_publicize_message":"[Office\u30d5\u30a1\u30a4\u30eb\u304b\u3089\u4f5c\u6210\u8005\u306a\u3069\u306e\u30d7\u30ed\u30d1\u30c6\u30a3\u3092\u53d6\u5f97\u3059\u308bVBScript]","jetpack_publicize_feature_enabled":true,"jetpack_social_post_already_shared":true,"jetpack_social_options":{"image_generator_settings":{"template":"highway","default_image_id":0,"font":"","enabled":false},"version":2}},"categories":[4,48,49,58,6],"tags":[],"class_list":["post-7240","post","type-post","status-publish","format-standard","has-post-thumbnail","hentry","category-office","category-excel-office","category-word-office","category-powerpoint","category-vbs"],"aioseo_notices":[],"jetpack_publicize_connections":[],"jetpack_featured_media_url":"https:\/\/www.ka-net.org\/blog\/wp-content\/uploads\/eyecatch-VBScript.png","jetpack_shortlink":"https:\/\/wp.me\/p4UZZr-1SM","jetpack_sharing_enabled":true,"_links":{"self":[{"href":"https:\/\/www.ka-net.org\/blog\/index.php?rest_route=\/wp\/v2\/posts\/7240","targetHints":{"allow":["GET"]}}],"collection":[{"href":"https:\/\/www.ka-net.org\/blog\/index.php?rest_route=\/wp\/v2\/posts"}],"about":[{"href":"https:\/\/www.ka-net.org\/blog\/index.php?rest_route=\/wp\/v2\/types\/post"}],"author":[{"embeddable":true,"href":"https:\/\/www.ka-net.org\/blog\/index.php?rest_route=\/wp\/v2\/users\/1"}],"replies":[{"embeddable":true,"href":"https:\/\/www.ka-net.org\/blog\/index.php?rest_route=%2Fwp%2Fv2%2Fcomments&post=7240"}],"version-history":[{"count":1,"href":"https:\/\/www.ka-net.org\/blog\/index.php?rest_route=\/wp\/v2\/posts\/7240\/revisions"}],"predecessor-version":[{"id":7243,"href":"https:\/\/www.ka-net.org\/blog\/index.php?rest_route=\/wp\/v2\/posts\/7240\/revisions\/7243"}],"wp:featuredmedia":[{"embeddable":true,"href":"https:\/\/www.ka-net.org\/blog\/index.php?rest_route=\/wp\/v2\/media\/7132"}],"wp:attachment":[{"href":"https:\/\/www.ka-net.org\/blog\/index.php?rest_route=%2Fwp%2Fv2%2Fmedia&parent=7240"}],"wp:term":[{"taxonomy":"category","embeddable":true,"href":"https:\/\/www.ka-net.org\/blog\/index.php?rest_route=%2Fwp%2Fv2%2Fcategories&post=7240"},{"taxonomy":"post_tag","embeddable":true,"href":"https:\/\/www.ka-net.org\/blog\/index.php?rest_route=%2Fwp%2Fv2%2Ftags&post=7240"}],"curies":[{"name":"wp","href":"https:\/\/api.w.org\/{rel}","templated":true}]}}