Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 7 Home Premium : 指定なし)
毎月フォルダ名、ファイル名が変更になる場合の対処の方法を教えてください。
投稿日時: 20/08/24 22:30:29
投稿者: miyuukate

お世話になっています。
毎月複数社から送信されてくるファイルを一つのフォルダに移動させる作業があります。
そこで各ファイルをまとめるフォルダに移動させるコードを作ってみました。
送信されてきたファイルを入れるフォルダ名は毎月違い、ファイル名も各社によって毎月違います。
 
フォルダ「202008」→フォルダ「10スイレン」→ファイル「スイレン
フォルダ「202008」→フォルダ「50バラ」→ファイル「バラ
赤字の部分が毎月変更になります。例)08→09など。ファイル名は毎月どう変わるかわかりません。
これを毎月、フォルダ「2020○○」のフォルダ「一覧用」に移動させます。
 
下記の形で作ってみましたが、これだと毎月フォルダ名ファイル名を修正しなければなりません。
毎月修正しなくてもいいようにするにはどのようにするのがいいかアドバイスお願いします。
 

Sub ファイル移動1()
    Dim FSO As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")
    FSO.CopyFile Source:="D:\202008\10スイレン\スイレン.xlsx", _
    Destination:="D:\202008\一覧用\10スイレン.xlsx"
    FSO.CopyFile Source:="D:\202008\50バラ\バラ.xlsx", _
    Destination:="D:\202008\一覧用\50バラ.xlsx"
    FSO.CopyFile Source:="D:\202008\30ヒマワリ\ヒマワリ.xlsx", _
    Destination:="D:\202008\一覧用\30ヒマワリ.xlsx"
    FSO.CopyFile Source:="D:\202008\40タンポポ\タンポポ.xlsx", _
    Destination:="D:\202008\一覧用\40タンポポ.xlsx"
    
     
    End Sub

回答
投稿日時: 20/08/24 22:42:48
投稿者: WinArrow
投稿者のウェブサイトに移動

質問1
各社から送ってくるのは「ファイル」ですか?
それとも、フォルダ毎送ってくるのでしょうか?
 
 

回答
投稿日時: 20/08/24 22:52:23
投稿者: WinArrow
投稿者のウェブサイトに移動

質問1の解説・・・疑問
D:\202008フォルダは、あなたのPCのフォルダですよね?
どのような形で送ってきて、どのような操作で
D:\202008フォルダに入るのでしょうか?、

投稿日時: 20/08/24 22:57:58
投稿者: miyuukate

WinArrow さんの引用:
質問1
各社から送ってくるのは「ファイル」ですか?
それとも、フォルダ毎送ってくるのでしょうか?
 
 

 
お世話になってます。
各社から送られてくるのは「ファイル」のみです。
それをそれぞれ毎月名前が変わるフォルダにまず入れていってます。
 
「ファイル」は各社からメールでエクセルで添付されてきており、それをあらかじめ作っておいたフォルダ「202080」に手動で移動させてます。
 

回答
投稿日時: 20/08/24 23:01:27
投稿者: simple

確認事項があります。
 
D:\202008\10スイレン\スイレン.xlsx
いうファイルを例にとると、
D:\202008\10スイレン 
というフォルダの下には、
スイレン.xlsxというファイルが一つあるだけですか?
 
(1)もし、二つ以上ファイルがあったら、
   それはどういうネーミングのファイルとしてコピーするんですか?
(2)もしひとつだけだとすると、あえてフォルダを作った意図は何ですか?

投稿日時: 20/08/24 23:15:04
投稿者: miyuukate

simple さんの引用:
確認事項があります。
 
D:\202008\10スイレン\スイレン.xlsx
いうファイルを例にとると、
D:\202008\10スイレン 
というフォルダの下には、
スイレン.xlsxというファイルが一つあるだけですか?
 
(1)もし、二つ以上ファイルがあったら、
   それはどういうネーミングのファイルとしてコピーするんですか?
(2)もしひとつだけだとすると、あえてフォルダを作った意図は何ですか?

 
 お世話になってます。
 (1)エクセルのファイルは毎月1つだけです。
   
 (2)エクセルファイルは1つだけなのですが…他にその月内に送られてきた
 PDFなどがまとめてフォルダに入れてあります。
  使用するのはエクセルファイルのみです。
   

回答
投稿日時: 20/08/24 23:24:48
投稿者: WinArrow
投稿者のウェブサイトに移動

miyuukate さんの引用:

「ファイル」は各社からメールでエクセルで添付されてきており、それをあらかじめ作っておいたフォルダ「202080」に手動で移動させてます。
 

予め作成するフォルダを
D:\202008\一覧表
にしておけば、VBAでの複写は不要ではないですか?
  
   
 

投稿日時: 20/08/24 23:41:21
投稿者: miyuukate

WinArrow さんの引用:
miyuukate さんの引用:

「ファイル」は各社からメールでエクセルで添付されてきており、それをあらかじめ作っておいたフォルダ「202080」に手動で移動させてます。
 

予め作成するフォルダを
D:\202008\一覧表
にしておけば、VBAでの複写は不要ではないですか?
  
   
 

 
説明が色々抜けていて申し訳ございません。
 
それがまず送られてきたファイルは各フォルダに入れておかなくてはならず、
その後、フォルダ「一覧表」にはファイルのみをコピーしたものを集めたいんです。
(そのため各ファイルが入ってるフォルダが邪魔になってくるのですが…各フォルダに
まず入れるという手順は省けないそうなんです。)
 ※移動と記述して紛らわしくしてしまいました、すみません。
 各ファイルをコピーしてフォルダ「一覧表」に入れる形です。

回答
投稿日時: 20/08/25 00:05:35
投稿者: WinArrow
投稿者のウェブサイトに移動

なうほど・・・
 
\10スイレン\スイレン.xlsx

10スイレン.xlsx
に名前変換して複写すれば、よいのですね?
 
複写先ファイル名は、複写元のフォルダ名を持ってくる
というロジックでよいのですか?

投稿日時: 20/08/25 00:20:14
投稿者: miyuukate

WinArrow さんの引用:
なうほど・・・
 
\10スイレン\スイレン.xlsx

10スイレン.xlsx
に名前変換して複写すれば、よいのですね?
 
複写先ファイル名は、複写元のフォルダ名を持ってくる
というロジックでよいのですか?

 
はい。それで大丈夫です。
 
この作業が毎月で、フォルダ「202008」が変わることと
(フォルダ「202009」「202010」などに)
送られてくる複写元となるファイル名も毎月変わってくることで…
(ファイル「スイレン9月」「スイレン送付」など)
フォルダ「一覧表」への複写のコードのフォルダ名やファイル名を
毎月修正しなくてもいい方法はないかと悩んでます。

回答
投稿日時: 20/08/25 00:20:29
投稿者: WinArrow
投稿者のウェブサイトに移動

↓のコードを試してみてください。
月が変わったとき、1ヶ所だけ変更吸うことにないますが・・・・
 
Dim FSO
Dim SRCFOLDER As Object, DSTFOLDER As Object, FOL, F
Const DSTSUB As String = "一覧用"
 
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set SRCFOLDER = FSO.GetFolder("D:\202008")
    Set DSTFOLDER = FSO.GetFolder(SRCFOLDER.Path & "\" & DSTSUB)
     
    For Each FOL In SRCFOLDER.subFolders
        If Not FOL.Path Like "*" & DSTSUB & "*" Then
            For Each F In FOL.Files
                If F.Name Like "*.xlsx" Then
                    FSO.CopyFile F.Path, DSTFOLDER.Path & "\" & FOL.Name & ".xlsx", True
                End If
            Next
        End If
    Next
    Set FSO = Nothing

投稿日時: 20/08/25 00:53:28
投稿者: miyuukate

WinArrow さんの引用:
↓のコードを試してみてください。
月が変わったとき、1ヶ所だけ変更吸うことにないますが・・・・
 
Dim FSO
Dim SRCFOLDER As Object, DSTFOLDER As Object, FOL, F
Const DSTSUB As String = "一覧用"
 
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set SRCFOLDER = FSO.GetFolder("D:\202008")
    Set DSTFOLDER = FSO.GetFolder(SRCFOLDER.Path & "\" & DSTSUB)
     
    For Each FOL In SRCFOLDER.subFolders
        If Not FOL.Path Like "*" & DSTSUB & "*" Then
            For Each F In FOL.Files
                If F.Name Like "*.xlsx" Then
                    FSO.CopyFile F.Path, DSTFOLDER.Path & "\" & FOL.Name & ".xlsx", True
                End If
            Next
        End If
    Next
    Set FSO = Nothing

 
試してみました!
来月を想定してダミーでフォルダ名もファイル名も変えて実行してみたところ、
ファイル名も変更になり、フォルダ「一覧用」に複写されました!
これなら修正箇所は¥202008のみなので、
私が最初作ってみたものと比べ格段に使いやすくなりました。
的確なアドバイス等ありがとうございます。大変助かりました。