{"id":3681,"date":"2013-09-30T16:21:17","date_gmt":"2013-09-30T07:21:17","guid":{"rendered":"http:\/\/www.ka-net.org\/blog\/?p=3681"},"modified":"2013-09-30T16:21:18","modified_gmt":"2013-09-30T07:21:18","slug":"%e3%83%9d%e3%83%bc%e3%82%bf%e3%83%96%e3%83%ab-%e3%83%87%e3%83%90%e3%82%a4%e3%82%b9%e3%81%8b%e3%82%89%e3%83%95%e3%82%a1%e3%82%a4%e3%83%ab%e3%82%92%e3%82%b3%e3%83%94%e3%83%bc%e3%81%99%e3%82%8bvba","status":"publish","type":"post","link":"https:\/\/www.ka-net.org\/blog\/?p=3681","title":{"rendered":"\u30dd\u30fc\u30bf\u30d6\u30eb \u30c7\u30d0\u30a4\u30b9\u304b\u3089\u30d5\u30a1\u30a4\u30eb\u3092\u30b3\u30d4\u30fc\u3059\u308bVBA\u30de\u30af\u30ed"},"content":{"rendered":"

moug\u306b\u3042\u3063\u305f\u8cea\u554f<\/a>\u95a2\u9023\u306e\u30e1\u30e2\u3067\u3059\u3002<\/p>\n

\u30dd\u30fc\u30bf\u30d6\u30eb \u30c7\u30d0\u30a4\u30b9\u304b\u3089\u30d5\u30a1\u30a4\u30eb\u3092\u30b3\u30d4\u30fc\u3059\u308b\u624b\u6bb5\u3068\u3057\u3066\u3001\u300cCopy\/Move Files from Portable Device<\/a>\u300d\u3067\u306fShell\u30aa\u30d6\u30b8\u30a7\u30af\u30c8\u304c\u4f7f\u308f\u308c\u3066\u3044\u307e\u3057\u305f\u3002<\/p>\n

\u203b Copy\/Move Files from Portable Device<\/a>\u306e\u30b3\u30fc\u30c9\u3092VBA\u5411\u3051\u306b\u76f4\u3057\u305f\u3082\u306e\u304c\u4e0b\u8a18\u306b\u306a\u308a\u307e\u3059\u3002<\/span><\/p>\n

Option Explicit\r\n\r\nPublic Sub GetFolderPath()\r\n  Dim fol As Object\r\n  \r\n  With CreateObject("Shell.Application")\r\n    Set fol = .BrowseForFolder(0, "\u30dd\u30fc\u30bf\u30d6\u30eb \u30c7\u30d0\u30a4\u30b9\u4e0a\u306e\u30d5\u30a9\u30eb\u30c0\u30fc\u3092\u9078\u629e\u3057\u3066\u304f\u3060\u3055\u3044\u3002", 0, "")\r\n    If fol Is Nothing Then Exit Sub\r\n    Debug.Print fol.Self.Path\r\n  End With\r\nEnd Sub\r\n\r\nPublic Sub CopyItems()\r\n  Dim srcFol As Object, dstFol As Object\r\n  Dim itm As Object\r\n  Const srcFolPath As String = "::{20D04FE0-\u2026" 'GetFolderPath\u30d7\u30ed\u30b7\u30fc\u30b8\u30e3\u30fc\u3067\u53d6\u5f97\u3057\u305f\u30dd\u30fc\u30bf\u30d6\u30eb \u30c7\u30d0\u30a4\u30b9\u4e0a\u306e\u30d5\u30a9\u30eb\u30c0\u30fc\u306e\u30d1\u30b9\r\n  Const dstFolPath As String = "C:\\Test" '\u30b3\u30d4\u30fc\u5148\u30d5\u30a9\u30eb\u30c0\u30fc\u306e\u30d1\u30b9\r\n  \r\n  With CreateObject("Shell.Application")\r\n    Set srcFol = .Namespace(srcFolPath)\r\n    Set dstFol = .Namespace(dstFolPath)\r\n    For Each itm In srcFol.Items\r\n      dstFol.CopyHere itm\r\n    Next\r\n  End With\r\n  Debug.Print "\u51e6\u7406\u304c\u7d42\u4e86\u3057\u307e\u3057\u305f\u3002"\r\nEnd Sub<\/pre>\n
BrowseForFolder\u3067\u30dd\u30fc\u30bf\u30d6\u30eb \u30c7\u30d0\u30a4\u30b9\u4e0a\u306e\u30d5\u30a9\u30eb\u30c0\u30fc\u306e\u30d1\u30b9\u3092\u53d6\u5f97\u3057\u3066\u3001CopyHere\u3067\u30d5\u30a1\u30a4\u30eb\u306e\u30b3\u30d4\u30fc\u3092\u884c\u3046\u5f62\u3067\u3059\u304c\u3001\u3044\u3061\u3044\u3061\u30d5\u30a9\u30eb\u30c0\u30fc\u3092\u9078\u629e\u3059\u308b\u306e\u306f\u9762\u5012\u306a\u306e\u3067\u3001\u30d5\u30a9\u30eb\u30c0\u30fc\u3092\u9078\u629e\u3059\u308b\u90e8\u5206\u3092\u7aef\u6298\u3063\u305f\u51e6\u7406\u3092\u8003\u3048\u3066\u307f\u307e\u3057\u305f\u3002<\/p>\n
Option Explicit\r\n\r\nPublic Sub Sample()\r\n  CopyPDItems "\u30b3\u30f3\u30d4\u30e5\u30fc\u30bf\u30fc\\(\u6a5f\u7a2e\u540d)\\SD\u30ab\u30fc\u30c9\\DCIM\\100MEDIA", "C:\\Test"\r\n  MsgBox "\u51e6\u7406\u304c\u7d42\u4e86\u3057\u307e\u3057\u305f\u3002", vbInformation + vbSystemModal\r\nEnd Sub\r\n\r\nPrivate Sub CopyPDItems(ByVal SrcFolderPath As String, ByVal DstFolderPath As Variant)\r\n'\u30dd\u30fc\u30bf\u30d6\u30eb \u30c7\u30d0\u30a4\u30b9\u306b\u3042\u308b\u30d5\u30a9\u30eb\u30c0\u30fc\u306e\u4e2d\u8eab\u3092\u6307\u5b9a\u3057\u305f\u30d5\u30a9\u30eb\u30c0\u30fc\u306b\u30b3\u30d4\u30fc\u3059\u308b\r\n' - SrcFolderPath:\u30b3\u30d4\u30fc\u5143\u30d5\u30a9\u30eb\u30c0\u30fc\u306e\u30d1\u30b9(\u30dd\u30fc\u30bf\u30d6\u30eb \u30c7\u30d0\u30a4\u30b9)\r\n' - DstFolderPath:\u30b3\u30d4\u30fc\u5148\u30d5\u30a9\u30eb\u30c0\u30fc\u306e\u30d1\u30b9\r\n\r\n  Dim PDFolderPath As Variant\r\n  Dim ParentFolderPath As Variant\r\n  Dim SrcFolder As Object, DstFolder As Object\r\n  Dim itm As Object\r\n  Dim v As Variant\r\n  Dim i As Long, num As Long\r\n  \r\n  PDFolderPath = "": ParentFolderPath = "" '\u521d\u671f\u5316\r\n  If Right(SrcFolderPath, 1) = ChrW(&H5C) Then SrcFolderPath = Left(SrcFolderPath, Len(SrcFolderPath) - 1) '\u53f3\u7aef\u306e\u30d1\u30b9\u30bb\u30d1\u30ec\u30fc\u30bf\u30fc\u9664\u53bb\r\n  v = Split(SrcFolderPath, ChrW(&H5C))\r\n  If v(0) = "\u30b3\u30f3\u30d4\u30e5\u30fc\u30bf\u30fc" Then '\u30d1\u30b9\u6700\u521d\u306e\u300c\u30b3\u30f3\u30d4\u30e5\u30fc\u30bf\u30fc\u300d\u306f\u7121\u8996\u3059\u308b\r\n    num = 1\r\n  Else\r\n    num = LBound(v)\r\n  End If\r\n  For i = num To UBound(v)\r\n    PDFolderPath = GetPDFolderPath(ParentFolderPath, v(i))\r\n    If Len(PDFolderPath) < 1 Then\r\n      MsgBox "\u30d5\u30a9\u30eb\u30c0\u30fc\u304c\u898b\u3064\u304b\u308a\u307e\u305b\u3093\u3002" & vbCrLf & "\u51e6\u7406\u3092\u4e2d\u6b62\u3057\u307e\u3059\u3002", vbCritical + vbSystemModal\r\n      Exit Sub\r\n    End If\r\n    ParentFolderPath = PDFolderPath\r\n  Next\r\n  With CreateObject("Shell.Application")\r\n    Set SrcFolder = .Namespace(PDFolderPath)\r\n    Set DstFolder = .Namespace(DstFolderPath)\r\n    If SrcFolder Is Nothing Or DstFolder Is Nothing Then\r\n      MsgBox "\u30d5\u30a9\u30eb\u30c0\u30fc\u304c\u898b\u3064\u304b\u308a\u307e\u305b\u3093\u3002" & vbCrLf & "\u51e6\u7406\u3092\u4e2d\u6b62\u3057\u307e\u3059\u3002", vbCritical + vbSystemModal\r\n      Exit Sub\r\n    End If\r\n    On Error Resume Next\r\n    For Each itm In SrcFolder.Items\r\n      DstFolder.CopyHere itm '\u30d5\u30a9\u30eb\u30c0\u30fc\u542b\u3081\u3066\u30b3\u30d4\u30fc\r\n    Next\r\n    If Err.Number <> 0 Then MsgBox "\u30a8\u30e9\u30fc\u304c\u767a\u751f\u3057\u307e\u3057\u305f\u3002" & vbCrLf & vbCrLf & "\u30a8\u30e9\u30fc\u756a\u53f7:" & Err.Number & vbCrLf & "\u30a8\u30e9\u30fc\u5185\u5bb9:" & Err.Description, vbCritical + vbSystemModal\r\n    On Error GoTo 0\r\n  End With\r\nEnd Sub\r\n\r\nPrivate Function GetPDFolderPath(ByVal ParentFolderPath As Variant, ByVal FolderName As String) As String\r\n  Dim ret As String\r\n  Dim fol As Object\r\n  Dim itm As Object\r\n  \r\n  ret = "": Set fol = Nothing '\u521d\u671f\u5316\r\n  With CreateObject("Shell.Application")\r\n    Set fol = .Namespace(ParentFolderPath)\r\n    If Not fol Is Nothing Then\r\n      For Each itm In fol.Items\r\n        If itm.Name = FolderName Then\r\n          ret = itm.Path\r\n          Exit For\r\n        End If\r\n      Next\r\n    End If\r\n  End With\r\n  GetPDFolderPath = ret\r\nEnd Function<\/pre>\n
\u4e0a\u8a18\u30b3\u30fc\u30c9\u3067\u306f\u300c\u30b3\u30f3\u30d4\u30e5\u30fc\u30bf\u30fc\\(\u6a5f\u7a2e\u540d)\\SD\u30ab\u30fc\u30c9\\DCIM\\100MEDIA<\/span>\u300d\u306e\u3088\u3046\u306a\u5f62\u3067\u30dd\u30fc\u30bf\u30d6\u30eb \u30c7\u30d0\u30a4\u30b9\u4e0a\u306e\u30d5\u30a9\u30eb\u30c0\u30fc\u306e\u30d1\u30b9\u3092\u6307\u5b9a\u3057\u3066\u3044\u307e\u3059\u3002
\n\u30a8\u30e9\u30fc\u306e\u51e6\u7406\u7b49\u5927\u96d1\u628a\u306b\u66f8\u3044\u3066\u3042\u308a\u307e\u3059\u304c\u3001\u4e00\u5fdc\u624b\u5143\u306e\u30b9\u30de\u30fc\u30c8\u30d5\u30a9\u30f3\u3067\u52d5\u4f5c\u78ba\u8a8d\u3067\u304d\u307e\u3057\u305f\u3002<\/p>\n","protected":false},"excerpt":{"rendered":"moug\u306b\u3042\u3063\u305f\u8cea\u554f\u95a2\u9023\u306e\u30e1\u30e2\u3067\u3059\u3002 \u30dd\u30fc\u30bf\u30d6\u30eb \u30c7\u30d0\u30a4\u30b9\u304b\u3089\u30d5\u30a1\u30a4\u30eb\u3092\u30b3\u30d4\u30fc\u3059\u308b\u624b\u6bb5\u3068\u3057\u3066\u3001\u300cCopy\/Move Files from Portable Device\u300d\u3067\u306fShell\u30aa\u30d6\u30b8\u30a7\u30af\u30c8\u304c\u4f7f\u308f\u308c\u3066\u3044\u307e\u3057\u305f\u3002 \u203b […]","protected":false},"author":1,"featured_media":7111,"comment_status":"open","ping_status":"open","sticky":false,"template":"","format":"standard","meta":{"_jetpack_memberships_contains_paid_content":false,"footnotes":"","jetpack_publicize_message":"","jetpack_publicize_feature_enabled":true,"jetpack_social_post_already_shared":false,"jetpack_social_options":{"image_generator_settings":{"template":"highway","default_image_id":0,"font":"","enabled":false},"version":2}},"categories":[4,48,49],"tags":[],"class_list":["post-3681","post","type-post","status-publish","format-standard","has-post-thumbnail","hentry","category-office","category-excel-office","category-word-office"],"aioseo_notices":[],"jetpack_publicize_connections":[],"jetpack_featured_media_url":"https:\/\/www.ka-net.org\/blog\/wp-content\/uploads\/eyecatch-Excel.png","jetpack_shortlink":"https:\/\/wp.me\/p4UZZr-Xn","jetpack_sharing_enabled":true,"_links":{"self":[{"href":"https:\/\/www.ka-net.org\/blog\/index.php?rest_route=\/wp\/v2\/posts\/3681","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=3681"}],"version-history":[{"count":1,"href":"https:\/\/www.ka-net.org\/blog\/index.php?rest_route=\/wp\/v2\/posts\/3681\/revisions"}],"predecessor-version":[{"id":3682,"href":"https:\/\/www.ka-net.org\/blog\/index.php?rest_route=\/wp\/v2\/posts\/3681\/revisions\/3682"}],"wp:featuredmedia":[{"embeddable":true,"href":"https:\/\/www.ka-net.org\/blog\/index.php?rest_route=\/wp\/v2\/media\/7111"}],"wp:attachment":[{"href":"https:\/\/www.ka-net.org\/blog\/index.php?rest_route=%2Fwp%2Fv2%2Fmedia&parent=3681"}],"wp:term":[{"taxonomy":"category","embeddable":true,"href":"https:\/\/www.ka-net.org\/blog\/index.php?rest_route=%2Fwp%2Fv2%2Fcategories&post=3681"},{"taxonomy":"post_tag","embeddable":true,"href":"https:\/\/www.ka-net.org\/blog\/index.php?rest_route=%2Fwp%2Fv2%2Ftags&post=3681"}],"curies":[{"name":"wp","href":"https:\/\/api.w.org\/{rel}","templated":true}]}}