質問編集履歴
2
余分な空白を削除しました
test
CHANGED
|
File without changes
|
test
CHANGED
|
@@ -52,8 +52,6 @@
|
|
|
52
52
|
|
|
53
53
|
Function 拡張子を取り除いたファイル移動() As FileSystemObject
|
|
54
54
|
|
|
55
|
-
|
|
56
|
-
|
|
57
55
|
Dim myFileFullName As String
|
|
58
56
|
|
|
59
57
|
Dim myFilePath As String
|
|
@@ -62,11 +60,11 @@
|
|
|
62
60
|
|
|
63
61
|
Dim myFileNameCut As String
|
|
64
62
|
|
|
65
|
-
Dim fso As New FileSystemObject
|
|
63
|
+
Dim fso As New FileSystemObject
|
|
66
64
|
|
|
67
65
|
Dim f As file
|
|
68
66
|
|
|
69
|
-
|
|
67
|
+
|
|
70
68
|
|
|
71
69
|
myFileFullName = ThisWorkbook.PATH & "*.psd"
|
|
72
70
|
|
|
@@ -77,12 +75,6 @@
|
|
|
77
75
|
|
|
78
76
|
|
|
79
77
|
Do While myFileName <> ""
|
|
80
|
-
|
|
81
|
-
'ファイルがなくなるまで繰り返す
|
|
82
|
-
|
|
83
|
-
|
|
84
|
-
|
|
85
|
-
'最後に「￥」つきのパス
|
|
86
78
|
|
|
87
79
|
myFilePath = Left(myFileFullName _
|
|
88
80
|
|
|
@@ -108,35 +100,29 @@
|
|
|
108
100
|
|
|
109
101
|
& vbCr & "拡張子を除いたファイル名：" & myFileNameCut
|
|
110
102
|
|
|
111
|
-
'95ではvbCrに替えてChr(13)を使用
|
|
112
103
|
|
|
113
104
|
|
|
105
|
+
If Dir(myFileName) <> "" Then
|
|
114
106
|
|
|
115
|
-
If Dir(myFileName) <> "" Then
|
|
116
|
-
|
|
117
|
-
fso.MoveFile myFileFullName, ThisWorkbook.PATH & "\" & myFileNameCut
|
|
107
|
+
fso.MoveFile myFileFullName, ThisWorkbook.PATH & "\" & myFileNameCut
|
|
118
108
|
|
|
119
109
|
Else: myFileFullName = myFilePath & "\" & myFileNameCut & ".psd"
|
|
120
110
|
|
|
121
|
-
End If
|
|
111
|
+
End If
|
|
122
112
|
|
|
123
|
-
For Each f In fso.MoveFile(myFileFullName, ThisWorkbook.PATH & "\" & myFileNameCut)
|
|
113
|
+
For Each f In fso.MoveFile(myFileFullName, ThisWorkbook.PATH & "\" & myFileNameCut)
|
|
124
114
|
|
|
125
|
-
Next
|
|
115
|
+
Next
|
|
126
116
|
|
|
127
|
-
End If
|
|
117
|
+
End If
|
|
128
118
|
|
|
129
|
-
myFileName = Dir()
|
|
119
|
+
myFileName = Dir()
|
|
130
120
|
|
|
131
|
-
Loop
|
|
121
|
+
Loop
|
|
132
122
|
|
|
133
|
-
|
|
123
|
+
Set fso = Nothing
|
|
134
124
|
|
|
135
|
-
Set fso = Nothing
|
|
136
|
-
|
|
137
|
-
|
|
138
|
-
|
|
139
|
-
End Function
|
|
125
|
+
End Function
|
|
140
126
|
|
|
141
127
|
```
|
|
142
128
|
|
1
※追記いたしました
test
CHANGED
|
File without changes
|
test
CHANGED
|
@@ -9,6 +9,28 @@
|
|
|
9
9
|
VBAでファイル移動システムを作っています。
|
|
10
10
|
|
|
11
11
|
ファイル名と移動先のフォルダ名が同じだった場合、それぞれ移動(複数)できる機能を実装中に以下のエラーメッセージが発生しました。
|
|
12
|
+
|
|
13
|
+
※説明不足で申し訳ございません。追記させていただきます。
|
|
14
|
+
|
|
15
|
+
・移動したいファイルはpsdデータです。
|
|
16
|
+
|
|
17
|
+
|
|
18
|
+
|
|
19
|
+
資料1.psd こちらを 資料1フォルダに格納させたいです。
|
|
20
|
+
|
|
21
|
+
同様に
|
|
22
|
+
|
|
23
|
+
資料2.psd こちらを 資料2フォルダに格納
|
|
24
|
+
|
|
25
|
+
…
|
|
26
|
+
|
|
27
|
+
こちらを繰り返します
|
|
28
|
+
|
|
29
|
+
拡張子があると反応しなかったので、一度拡張子(.psd)を外した状態の名前を抽出して
|
|
30
|
+
|
|
31
|
+
そちらを使ってmove.File で移動できればと思いました。
|
|
32
|
+
|
|
33
|
+
|
|
12
34
|
|
|
13
35
|
|
|
14
36
|
|
|
@@ -78,8 +100,6 @@
|
|
|
78
100
|
|
|
79
101
|
|
|
80
102
|
|
|
81
|
-
|
|
82
|
-
|
|
83
103
|
Debug.Print "選択されたファイル" & myFileFullName _
|
|
84
104
|
|
|
85
105
|
& vbCr & "ファイル名：" & myFileName _
|
|
@@ -90,53 +110,25 @@
|
|
|
90
110
|
|
|
91
111
|
'95ではvbCrに替えてChr(13)を使用
|
|
92
112
|
|
|
93
|
-
|
|
113
|
+
|
|
94
114
|
|
|
95
115
|
If Dir(myFileName) <> "" Then
|
|
96
116
|
|
|
97
|
-
|
|
98
|
-
|
|
99
|
-
|
|
100
|
-
|
|
101
117
|
fso.MoveFile myFileFullName, ThisWorkbook.PATH & "\" & myFileNameCut
|
|
102
|
-
|
|
103
|
-
|
|
104
|
-
|
|
105
|
-
|
|
106
118
|
|
|
107
119
|
Else: myFileFullName = myFilePath & "\" & myFileNameCut & ".psd"
|
|
108
120
|
|
|
109
|
-
|
|
110
|
-
|
|
111
|
-
|
|
112
|
-
|
|
113
121
|
End If
|
|
114
|
-
|
|
115
|
-
|
|
116
122
|
|
|
117
123
|
For Each f In fso.MoveFile(myFileFullName, ThisWorkbook.PATH & "\" & myFileNameCut)
|
|
118
124
|
|
|
125
|
+
Next
|
|
119
126
|
|
|
127
|
+
End If
|
|
120
128
|
|
|
121
|
-
Next
|
|
122
|
-
|
|
123
|
-
|
|
124
|
-
|
|
125
|
-
End If
|
|
126
|
-
|
|
127
|
-
|
|
128
|
-
|
|
129
|
-
|
|
129
|
+
myFileName = Dir()
|
|
130
|
-
|
|
131
|
-
|
|
132
|
-
|
|
133
|
-
|
|
134
|
-
|
|
135
|
-
|
|
136
130
|
|
|
137
131
|
Loop
|
|
138
|
-
|
|
139
|
-
|
|
140
132
|
|
|
141
133
|
'後始末
|
|
142
134
|
|