‘ここでエラー52が発生の箇所で「実行時エラー52:ファイル名または番号が不正です」が発生してしまいます。
意図としては、特定のフォルダ内の「共益」フォルダ(GetAttr(adr) = 16)に該当する場合には、それ以下の処理をしてくださいという指示なのですが、不思議なことに私のデバイスで実行するとエラーが発生せず、隣のPCで実行すると上記のエラーがでます。
当該エラーを調べてみるとOpenステートメントに関連して発生するとされているのですが、ご覧の通りOpenステートメントは使用していないですし、環境によって実行できる場合とできない場合が発生しているので手詰まりになってしまいました。
同じような経験や解決方法に知見のあるかたがいればアドバイスを頂けると大変ありがたいです。
宜しくお願い申し上げます。
vba
1Sub getFolderStruct() 2Dim i As Long 3Dim j As Long 4Dim YYYYMM As String 5Dim fileName As String 6Dim Dic As Object 7Dim buf As String 8Dim itemsdic As Variant 9 10Dim eachPath As String 11Dim deepPath As String 12Dim hypLink As Hyperlink 13 14Dim adr As String 15Dim deepAdr As String 16 17Dim fso As Object 18Dim n As Long 19Dim m As Integer 20 21Set fso = CreateObject("Scripting.FileSystemObject") 22 23YYYYMM = Cells(6, 4).Value 24 25If YYYYMM = "" Then 26 MsgBox "YYYYMMに出力したいフォルダパスを入力してね" & vbCrLf & "「処理を終了します」" 27 Exit Sub 28End If 29 30If Cells(4, 6).Value <> "" Then 31 MsgBox "DebugAreaをクリーンにしてください" & vbCrLf & "「処理を終了します」" 32 Exit Sub 33End If 34 35fileName = Dir(ThisWorkbook.path & "\" & YYYYMM & "*", vbDirectory) 36 37 38Set Dic = CreateObject("Scripting.Dictionary") 39 40Do While fileName <> "" 41 If fileName <> "." And fileName <> ".." Then 42 Dic.Add fileName, fileName 43 End If 44 fileName = Dir() 45Loop 46 47i = 4 48 For Each itemsdic In Dic 49 50 eachPath = Dir(ThisWorkbook.path & "\" & YYYYMM & "\" & itemsdic & "*", vbDirectory) 51 Do While eachPath <> "" 52 adr = ThisWorkbook.path & "\" & YYYYMM & "\" & itemsdic & "\" & eachPath 53 54 55 If eachPath <> "." And eachPath <> ".." And GetAttr(adr) = 16 And eachPath = "共益" Then ‘ここでエラー52が発生 56 Cells(i, 6).Value = itemsdic 57 Set hypLink = ActiveSheet.Cells(i, 7).Hyperlinks.Add( _ 58 Anchor:=Cells(i, 7), _ 59 Address:=adr, _ 60 TextToDisplay:=eachPath) 61 62 deepPath = ThisWorkbook.path & "\" & YYYYMM & "\" & itemsdic & "\共益" 63 n = fso.GetFolder(deepPath).SubFolders.Count 64 65 i = i + 1 66 m = i + n 67 For j = i To m 68 Cells(j, 6).Value = itemsdic 69 Cells(j, 7).Value = ">" 70 Next 71 72 i = i + n 73 74 75 ElseIf eachPath <> "." And eachPath <> ".." And GetAttr(adr) = 16 And eachPath <> "共益" Then 76 Cells(i, 6).Value = itemsdic 77 Set hypLink = ActiveSheet.Cells(i, 7).Hyperlinks.Add( _ 78 Anchor:=Cells(i, 7), _ 79 Address:=adr, _ 80 TextToDisplay:=eachPath) 81 82 i = i + 1 83 End If 84 eachPath = Dir() 85 Loop 86 Next 87 88 Dim k As Long 89 Dim camPath As String 90 Dim camAdr As String 91 92 k = 4 93 Do While Cells(k, 7) <> "" 94 If Cells(k, 7) = "共益" Then 95 camPath = Dir(ThisWorkbook.path & "\" & YYYYMM & "\" & Cells(k, 6) & "\" & "共益*", vbDirectory) 96 Do While camPath <> "" 97 camAdr = ThisWorkbook.path & "\" & YYYYMM & "\" & Cells(k, 6) & "\" & "共益\" & camPath 98 If camPath <> "." And camPath <> ".." And GetAttr(camAdr) = 16 Then 99 Set hypLink = ActiveSheet.Cells(k + 1, 8).Hyperlinks.Add( _ 100 Anchor:=Cells(k + 1, 8), _ 101 Address:=camAdr, _ 102 TextToDisplay:=camPath) 103 k = k + 1 104 End If 105 camPath = Dir() 106 Loop 107 Else 108 k = k + 1 109 End If 110 111 112 Loop 113 114End Sub
回答1件
あなたの回答
tips
プレビュー