質問編集履歴
2
余分な空白を削除しました
title
CHANGED
|
File without changes
|
body
CHANGED
|
@@ -25,22 +25,18 @@
|
|
|
25
25
|
### 該当のソースコード
|
|
26
26
|
```
|
|
27
27
|
Function 拡張子を取り除いたファイル移動() As FileSystemObject
|
|
28
|
-
|
|
29
28
|
Dim myFileFullName As String
|
|
30
29
|
Dim myFilePath As String
|
|
31
30
|
Dim myFileName As String
|
|
32
31
|
Dim myFileNameCut As String
|
|
33
|
-
|
|
32
|
+
Dim fso As New FileSystemObject
|
|
34
33
|
Dim f As file
|
|
35
|
-
|
|
34
|
+
|
|
36
35
|
myFileFullName = ThisWorkbook.PATH & "*.psd"
|
|
37
36
|
If myFileFullName = "*.psd" Then Exit Function
|
|
38
37
|
myFileName = Dir(myFileFullName)
|
|
39
38
|
|
|
40
39
|
Do While myFileName <> ""
|
|
41
|
-
'ファイルがなくなるまで繰り返す
|
|
42
|
-
|
|
43
|
-
'最後に「￥」つきのパス
|
|
44
40
|
myFilePath = Left(myFileFullName _
|
|
45
41
|
, Len(myFileFullName) - Len(myFileName))
|
|
46
42
|
If InStr(myFileName, ".") = 0 Then
|
|
@@ -53,21 +49,18 @@
|
|
|
53
49
|
& vbCr & "ファイル名：" & myFileName _
|
|
54
50
|
& vbCr & "パス：" & myFilePath _
|
|
55
51
|
& vbCr & "拡張子を除いたファイル名：" & myFileNameCut
|
|
56
|
-
'95ではvbCrに替えてChr(13)を使用
|
|
57
52
|
|
|
58
|
-
If Dir(myFileName) <> "" Then
|
|
53
|
+
If Dir(myFileName) <> "" Then
|
|
59
|
-
|
|
54
|
+
fso.MoveFile myFileFullName, ThisWorkbook.PATH & "\" & myFileNameCut
|
|
60
55
|
Else: myFileFullName = myFilePath & "\" & myFileNameCut & ".psd"
|
|
61
|
-
|
|
56
|
+
End If
|
|
62
|
-
|
|
57
|
+
For Each f In fso.MoveFile(myFileFullName, ThisWorkbook.PATH & "\" & myFileNameCut)
|
|
63
|
-
|
|
58
|
+
Next
|
|
64
|
-
|
|
59
|
+
End If
|
|
65
|
-
|
|
60
|
+
myFileName = Dir()
|
|
66
|
-
|
|
61
|
+
Loop
|
|
67
|
-
'後始末
|
|
68
|
-
Set fso = Nothing
|
|
62
|
+
Set fso = Nothing
|
|
69
|
-
|
|
70
|
-
End Function
|
|
63
|
+
End Function
|
|
71
64
|
```
|
|
72
65
|
### 試したこと
|
|
73
66
|
|
1
※追記いたしました
title
CHANGED
|
File without changes
|
body
CHANGED
|
@@ -4,7 +4,18 @@
|
|
|
4
4
|
ここに質問の内容を詳しく書いてください。
|
|
5
5
|
VBAでファイル移動システムを作っています。
|
|
6
6
|
ファイル名と移動先のフォルダ名が同じだった場合、それぞれ移動(複数)できる機能を実装中に以下のエラーメッセージが発生しました。
|
|
7
|
+
※説明不足で申し訳ございません。追記させていただきます。
|
|
8
|
+
・移動したいファイルはpsdデータです。
|
|
7
9
|
|
|
10
|
+
資料1.psd こちらを 資料1フォルダに格納させたいです。
|
|
11
|
+
同様に
|
|
12
|
+
資料2.psd こちらを 資料2フォルダに格納
|
|
13
|
+
…
|
|
14
|
+
こちらを繰り返します
|
|
15
|
+
拡張子があると反応しなかったので、一度拡張子(.psd)を外した状態の名前を抽出して
|
|
16
|
+
そちらを使ってmove.File で移動できればと思いました。
|
|
17
|
+
|
|
18
|
+
|
|
8
19
|
### 発生している問題・エラーメッセージ
|
|
9
20
|
|
|
10
21
|
```
|
|
@@ -38,36 +49,21 @@
|
|
|
38
49
|
myFileNameCut = Left(myFileName _
|
|
39
50
|
, InStr(myFileName, ".") - 1)
|
|
40
51
|
|
|
41
|
-
|
|
42
52
|
Debug.Print "選択されたファイル" & myFileFullName _
|
|
43
53
|
& vbCr & "ファイル名：" & myFileName _
|
|
44
54
|
& vbCr & "パス：" & myFilePath _
|
|
45
55
|
& vbCr & "拡張子を除いたファイル名：" & myFileNameCut
|
|
46
56
|
'95ではvbCrに替えてChr(13)を使用
|
|
47
|
-
|
|
57
|
+
|
|
48
58
|
If Dir(myFileName) <> "" Then
|
|
49
|
-
|
|
50
|
-
|
|
51
59
|
fso.MoveFile myFileFullName, ThisWorkbook.PATH & "\" & myFileNameCut
|
|
52
|
-
|
|
53
|
-
|
|
54
60
|
Else: myFileFullName = myFilePath & "\" & myFileNameCut & ".psd"
|
|
55
|
-
|
|
56
|
-
|
|
57
61
|
End If
|
|
58
|
-
|
|
59
62
|
For Each f In fso.MoveFile(myFileFullName, ThisWorkbook.PATH & "\" & myFileNameCut)
|
|
60
|
-
|
|
61
|
-
|
|
63
|
+
Next
|
|
62
|
-
|
|
63
|
-
|
|
64
|
+
End If
|
|
64
|
-
|
|
65
|
-
|
|
65
|
+
myFileName = Dir()
|
|
66
|
-
|
|
67
|
-
|
|
68
|
-
|
|
69
66
|
Loop
|
|
70
|
-
|
|
71
67
|
'後始末
|
|
72
68
|
Set fso = Nothing
|
|
73
69
|
|