[[20160302202149]] 『ブックを特定のファイルへ保存するマクロ』(田村) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『ブックを特定のファイルへ保存するマクロ』(田村)

教えてください。

例えば【0301】というフォルダがあって、

あるシートのセルA1に2016/03/01と入力してマクロを回すとそのフォルダに保存されるコードを知りたいです。

< 使用 Excel:unknown、使用 OS:unknown >


 
マクロの記録でできるのでは?
 
(C.K) 2016/03/02(水) 21:45

 「マクロの記録」と云う機能があります。

 その機能をスタートさせて、
  「あるシートのセルA1に2016/03/01と入力し、【0301】というフォルダに保存して」から
 その機能を終了してみてください。

 そうすると、自動的にマクロコードが書かれます。

 そのままじゃ、旨く動かないですが、そのコードをここにアップして貰えると回答側も手間が省けます。

(半平太) 2016/03/02(水) 21:50


上手く伝えることができずすみません。

やりたいことというのは、
よく見る"mmdd"のようなコードを用いて、
A1の日付と同じ名前のフォルダを探して、
自動的にそのフォルダに保存される仕組みを知りたいんです。

【0301】...【0331】という具合に沢山フォルダがあったとして、
A1に2016/03/02という値を入れてボタンを押すと【0302】のフォルダに保存されるようなことです。
(田村) 2016/03/02(水) 22:25


To 田村さん
 マクロを実行ブックと同じフォルダ内に、日付フォルダがあるか探します。

 日付フォルダは、「2016_03_04」のようにしてみました。

 Sheet1のA1に「2016/3/4」と入力後、プログラムを実行してください。
 その後、
 Sheet1のA1に「2016/3/5」と入力後、再び、プログラム実行してください。

 日付は、「Ctrl+;」で本日の日付が入力されます。
 *********************************************************************

 Option Explicit

 Sub ブックを特定のフォルダに保存()
    Dim sh1 As Worksheet, msg As String
    Dim xfolder As String      '保存先フォルダ
    Dim xfile As String        '保存ファイル
    Dim xfolderfull As Variant '保存先フォルダ(fullpath)
    Dim xfilefull As Variant   '保存ファイル(fullpath)
    Dim x As String, y As String

    Application.ScreenUpdating = False
    Application.EnableEvents = False

     Set sh1 = ThisWorkbook.Sheets("Sheet1")'★シート名
     xfolder = Replace(sh1.Range("A1").Value, "/", "_")
     xfile = ThisWorkbook.Name
     xfolderfull = ThisWorkbook.Path & "\" & xfolder
     xfilefull = xfolderfull & "\" & xfile
     x = ThisWorkbook.FullName '元のマクロブックの場所

    '保存先フォルダがなければ作成
     If Dir(xfolderfull, vbDirectory) = "" Then MkDir xfolderfull

     If Dir(xfilefull) = "" Then '存在しなければ
        ThisWorkbook.SaveAs Filename:=xfilefull '別の場所に保存
        Application.DisplayAlerts = False
        ThisWorkbook.SaveAs Filename:=x '元の場所に保存
        Application.DisplayAlerts = True
     Else
        msg = "上書きしますか?" & vbCrLf & xfilefull
        If MsgBox(msg, vbYesNo) = vbNo Then Exit Sub
        Application.DisplayAlerts = False
        ThisWorkbook.SaveAs Filename:=xfilefull '別の場所に保存(上書き)
        ThisWorkbook.SaveAs Filename:=x '元の場所に保存
        Application.DisplayAlerts = True
     End If

     Set sh1 = Nothing
    Application.ScreenUpdating = True
    Application.EnableEvents = True

 End Sub
(マリオ) 2016/03/02(水) 23:15

 「を」が余計でした(^^♪
 (訂正前)マクロを実行ブックと
 (訂正前)マクロ実行ブックと

 >よく見る"mmdd"のようなコードを用いて、 
 xfolder = Replace(sh1.Range("A1").Value, "/", "_")
 を
 xfolder = Format(sh1.Range("A1"), "mmdd")
 に変えてみてください。
(マリオ) 2016/03/02(水) 23:23

>上手く伝えることができずすみません。
いやあ、伝わってますよ、十分に。
あなたが回答者のコメントを理解していないだけですよ。

ファイルを保存する動作をマクロ記録して、
そのパス名に含まれるフォルダの一部を、
Format(Range("A1").Value, "mmdd")
で書き換えればいいんです、と申し上げているんですよ。

http://excelfactory.net/excelboard/excelvba/excel.cgi?mode=all&namber=174661&rev=0
でも指摘したとおもうが、
それを無視するほうがどうかしてない?

コードの提供がありましたが、
保存する対象と、マクロを書くブックの関係を
よく確認する必要があります。

(γ) 2016/03/03(木) 07:07


マリオ様
ありがとうございます。確認してみます。

γ様
ご指摘頂いていたのに気付かず大変失礼致しました。

お二方から頂いたコードを理解し消化できるよう努めてみます。

その時に新たな問題が出ましたらこちらで相談させて頂きます。
(田村) 2016/03/03(木) 23:25


 To 田村さん

 (マリオ) 2016/03/02(水) 23:15のプログラム、試してみましたか?
 田村さんが思い描いていたプログラムになっていますか?感想もなしですか?

(マリオ) 2016/03/03(木) 23:52


マリオ様
失礼しました。コードを理解しようとずっと眺めていました。
試してみたところ、思った通り出来ました。ありがとうございます。
不器用な者でやりたいことをとにかく簡単な部品に分けて質問しようと思い、
そうすれば頂いた回答も理解していけると思っているのですが、
それでもこれほど長いコードになるのですね。少々混乱しています。
マリオ様 γ様 本当にすみません。
(田村) 2016/03/04(金) 01:32

複数の方から、マクロ記録の利用が提案されているのですが、
それにトライする気は全然無いということですか?
それともマクロ記録ということを知らない?

ちなみに、提案されたコードは、マクロが書かれたブック(ThisWorkbook)を
2カ所に保存することになっています。
それはあなたのご希望に沿ったものなんですか?
保存したいファイルに逐一マクロを登録しないと保存できないよ。
Activeなブックを保存する必要があるんじゃないかと思うけどねえ。
(γ) 2016/03/04(金) 07:19


 To 田村 さん
 見ていましたら、★印の質問に回答願います。

 ★想像ですが、【共有フォルダ】に、「0301」フォルダを作成して、
 ★「0301」フォルダの中に、マクロを実行するエクセルファイル(ThisWorkbook)ではなく、
 ★「0301」フォルダの中に、指定したファイルを保存したいのではないのですか?
 上のコードは、ThisWorkbookを2か所に保存する、訳の分からないプログラムになっています。

 >不器用な者でやりたいことをとにかく簡単な部品に分けて質問しようと思い、 
 ★やりたいことが伝わってきません。順序立てて、説明してみようとは思わないのですか?
 下記の(1),(2),(3)に分けて、説明してみてくだい。
 (1)マクロを実行するエクセルファイル
 (2)保存元のフォルダ(保存元のファイル名)
 (3)保存先のフォルダ(保存ファイル名)

 ★マクロの記録のやり方は、知ってますか?

(マリオ) 2016/03/04(金) 09:33


γ様 マリオ様
重ね重ねお手を煩わせ申し訳ありません。
やりたいことを細かく分けて質問することで逆に回答者の方を、そして自分自身をも混乱させていたように思います。
全て説明致します。

毎日、色々な会社からエクセルファイルが添付されたメールが100通近く届きます。
どの会社からのファイルも決まったフォーマットで、
ファイル名は【AA商事_発注書0306】や、【BB組合_発注書0308】という具合です。
シート3のセルC2に日付が(AA商事なら"0306"と)入っています。
これが>(2)保存元のフォルダ(保存元のファイル名)です

そして、そのファイルを確認し、閉じて、自社の共有フォルダにある【0306】【0307】【0308】、、、というそれぞれのフォルダにドラッグしていく作業(2〜3人で行う作業です)を行っています。
これが>(3)保存先のフォルダ(保存ファイル名)です

この作業において以前にドラッグのし忘れが発生しました。

それを防ぐために『ファイルのクローズと保存を同時に行う』マクロを作成できれば上記のようなミスが発生しにくくなると考えました。
これが>(1)マクロを実行するエクセルファイルです

>★「0301」フォルダの中に、指定したファイルを保存したい
これが最終的な希望です。
なので私としてはマリオ様から教えて貰ったコードをそのまま使用するのではなく、理解して、上記のマクロを作るにあたり自分で修正できたらと思っていたのですが今の自分には難しそうです。

マクロの記録は存じています。このようなコードになりました。
Application.ActiveProtectedViewWindow.Edit

    ChDir "\\****\****\2016\3月\0306"
    ActiveWorkbook.SaveAs Filename:= _
        "\\****\****\2016\3月\0306\コピーTEST_発注書0306.xlsx" _
        , FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWindow.Close

(田村) 2016/03/05(土) 00:20


これから出掛けてしまうので時間がとれませんが、
いくつか確認したい点があります。

1.ファイル名にある0306といった文字列の意味は?
 もともとのファイル名が日付を含んでいるのですか?
 それともシート3のセルC2に日付をもとに作業者がつけかえたのですか?
2.ドラッグするということは、メールからどこかのフォルダにいったん保存しているのですね?
3.ファイルを開いて保存すると、ファイルのタイムスタンプ(更新時刻)が変わりますし、
 意図しない内容変更が混入するリスクがありえます。そこはどう整理していますか?
4.共同作業の分担はどうされているのですか?重複、漏れ等は発生しない仕組みが確保されているのですか?
5.使用しているメールソフトによっては、メールから直接各フォルダに保存することも可能でしょう。
 そうした検討はしていますか?する予定はありますか?
 それともそれは所与のことで検討範囲外ですか?

(γ) 2016/03/05(土) 07:14


 To 田村 さん

  (1)マクロを実行するエクセルファイル
  (2)保存元のフォルダ(保存元のファイル名)
  (3)保存先のフォルダ(保存ファイル名)
  と分けましたが、
  (1)マクロを実行するエクセルファイル
  (2)移動元フォルダ(内容確認済みのメールの添付ファイルの名前:移動元のファイル名)
  (3)移動先フォルダ(ファイルの名前は、移動元のファイル名と同じ)
  と分けて考えたいと思います。
 **************************************************************************************************************
 ★第1の質問
 添付されたエクセルファイル【AA商事_発注書0306】は、もとから日付を含んでいるのですか?
 数字は、日付だけですか?例えば、【第1印刷株式会社_発注書0307】など、
 日付以外の数字があったりしますか?最後の4文字を日付で表しているのかな?

 ★第2の質問
  添付されたエクセルファイルのファイルの拡張子は何ですか?(xlsx,xls,xlsm,xltx,xltなど…)、
  シートが1つのcsvファイルなどはありませんか?

 ★第3の質問
  移動元ファイルの(シート名:Sheet3)のセルC2に、数式は入力されていますか?入力されていたら、その数式を教えてください

 ★第4の質問
 次のような処理は、どうですか?
 デスクトップにフォルダ「フォルダ名:メール添付ファイル」を作成して、
 その中に、次の3つを置く。
 ・フォルダ「フォルダ名:Mail(未)」
 ・フォルダ「フォルダ名:Mail(確認済)」
 ・自動振り分け(マクロ実行ブック).xlsm

 デスクトップがCドライブ上にあるとして、
 (1)メールの添付ファイルを「C:\Users\●●\Desktop\メール添付ファイル\Mail(未)」フォルダに保存する。
 (2)内容確認済みのメールの添付ファイル(移動元のファイル名)を
  「C:\Users\●●\Desktop\メール添付ファイル\Mail(確認済)」フォルダ(移動元フォルダ)に手作業で移動する。
 (3)自動振り分け(マクロ実行ブック).xlsmのマクロを実行すると、フォルダ「フォルダ名:Mail(確認済)」内にある
  移動元のファイル名、例えば、【AA商事_発注書0306】から数字だけを取り出して、【0306】を取得し、
  移動先のフォルダ(指定した共有フォルダ)内にある【0306】フォルダ内に、移動元のファイルを自動で振り分ける。
  この作業をマクロでファイル数だけ繰り返す。なお、【0306】フォルダがなければ、自動で作成する。

 ★第5の質問
 共有フォルダのディレクトリ(フォルダのパス)を教えてください。(●●印で部分的に表示を伏せたりして)
 例えば、\\●●\共有フォルダ\2016
 **************************************************************************************************************
 >それを防ぐために『ファイルのクローズと保存を同時に行う』マクロを作成できれば上記のような
 >ミスが発生しにくくなると考えました。これが(1)マクロを実行するエクセルファイルです

 エクセルのアドインを作成すれば、いいのかな?開いているファイルを閉じて、移動(振り分け)するんですよね…。
 できたとして、会社のPCに、アドインをインストールするのは、よくないかな〜。

(マリオ) 2016/03/05(土) 17:47


γ様

>1.ファイル名にある0306といった文字列の意味は?

  もともとのファイル名が日付を含んでいるのですか? 
  それともシート3のセルC2に日付をもとに作業者がつけかえたのですか? 

文字列の意味は日付です。
送られてくるファイル名が最初からそうなっていますので作業者はファイル名を変えません。

>2.ドラッグするということは、メールからどこかのフォルダにいったん保存しているのですね?

いったんというよりメールに添付されてるファイルをそのまま共有フォルダにドラッグして作業終了です。
※ちなみに保存先である【0306】【0307】...というようなフォルダは最初から出来ています。

>3.ファイルを開いて保存すると、ファイルのタイムスタンプ(更新時刻)が変わりますし、

  意図しない内容変更が混入するリスクがありえます。そこはどう整理していますか? 

これは中を確認し問題無ければそのままドラッグしますし、
あればこちらで修正し【名前を付けて保存】でフォルダに保存します。
更新時刻が変わるのは問題ございません
※ちなみに修正した場合にもファイル名は変えません。

>4.共同作業の分担はどうされているのですか?重複、漏れ等は発生しない仕組みが確保されているのですか?

これらのメールは共有の受信ボックスに届くので、
処理する人がoutlookの(分類項目)に任意の色を付けて処理が被らないようにしております。

>5.使用しているメールソフトによっては、メールから直接各フォルダに保存することも可能でしょう。

  そうした検討はしていますか?する予定はありますか? 
  それともそれは所与のことで検討範囲外ですか? 

これはすみません知識不足でよくイメージが湧きません。
中を確認し、フォルダに保存するという2つの工程を漏れなく行えれば良いです。

お願いします
(田村) 2016/03/05(土) 21:32


マリオ様

 ★第1の質問
 添付されたエクセルファイル【AA商事_発注書0306】は、もとから日付を含んでいるのですか?
 数字は、日付だけですか?例えば、【第1印刷株式会社_発注書0307】など、
 日付以外の数字があったりしますか?最後の4文字を日付で表しているのかな?

もとから日付を含んでいます。
日付以外の数字はありません。
最後の4文字を日付で表しています。

 ★第2の質問
  添付されたエクセルファイルのファイルの拡張子は何ですか?(xlsx,xls,xlsm,xltx,xltなど…)、
  シートが1つのcsvファイルなどはありませんか?

拡張子はxlsxです。csvはございません。

 ★第3の質問
  移動元ファイルの(シート名:Sheet3)のセルC2に、数式は入力されていますか?入力されていたら、その数式を教えてください

数式は入力されていません。
例えば【AA酒造店_発注書0306】というファイルを開くと、
Sheet3のセルC2に"2016/3/6"と入っているのみです。
※すみません前の質問では"0306"と↑書いてしまっていました。

 ★第4の質問
 次のような処理は、どうですか?
 デスクトップにフォルダ「フォルダ名:メール添付ファイル」を作成して、
 その中に、次の3つを置く。
 ・フォルダ「フォルダ名:Mail(未)」
 ・フォルダ「フォルダ名:Mail(確認済)」
 ・自動振り分け(マクロ実行ブック).xlsm

 デスクトップがCドライブ上にあるとして、
 (1)メールの添付ファイルを「C:\Users\●●\Desktop\メール添付ファイル\Mail(未)」フォルダに保存する。
 (2)内容確認済みのメールの添付ファイル(移動元のファイル名)を
  「C:\Users\●●\Desktop\メール添付ファイル\Mail(確認済)」フォルダ(移動元フォルダ)に手作業で移動する。
 (3)自動振り分け(マクロ実行ブック).xlsmのマクロを実行すると、フォルダ「フォルダ名:Mail(確認済)」内にある
  移動元のファイル名、例えば、【AA商事_発注書0306】から数字だけを取り出して、【0306】を取得し、
  移動先のフォルダ(指定した共有フォルダ)内にある【0306】フォルダ内に、移動元のファイルを自動で振り分ける。
  この作業をマクロでファイル数だけ繰り返す。なお、【0306】フォルダがなければ、自動で作成する。

すみません、これに関してはよくイメージが湧きません。
>(移動元フォルダ)に手作業で移動する。
とありますが、自分としてはメールに添付されているファイルを開いて確認した後の、
『ファイルのクローズと指定のフォルダへの保存が同時に行われるマクロ』が必要だと考えています。
A社から来たメールの添付ファイルを確認し、保存し、そして次はB社のメールを...
という具合にやっていたらファイルを確認しただけで保存をし忘れた事例があったので、
それであればファイルは見たら必ず閉じるのだから閉じるときに自動的に指定のフォルダに保存される仕組み
があれば良いのでは?という考えです。

 ★第5の質問
 共有フォルダのディレクトリ(フォルダのパス)を教えてください。(●●印で部分的に表示を伏せたりして)
 例えば、\\●●\共有フォルダ\2016

すみません、これは会社に行かないと確認できないのですが、
\\●●\Other\2016\3月
このような形だったと思います。

また、アドインという言葉を恥ずかしながら存じ上げてなく今調べてみたのですが仰る通り、会社では厳しいかと思われます...

お願いします
(田村) 2016/03/05(土) 21:33


 まず、マクロ記録との関係だけ書いておきましょう。
 マクロ記録で得られた
    ActiveWorkbook.SaveAs Filename:= _
         "\\****\****\2016\3月\0306\コピーTEST_発注書0306.xlsx" _
         , FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
     ActiveWindow.Close
 だけが大切なところです。

 必要最低限のコードは、こんなことになるでしょう。

 Sub test()
     Dim fileName    As String
     Dim folderName  As String
     Dim d           As String
     Dim pathName    As String

     folderName = "\\****\****\2016\3月\"  ' ここは3月中は固定しておくものとする

     fileName = ActiveWorkbook.Name
     d = Format(Worksheets("Sheet3").Range("C2").Value, "mmdd")
     pathName = folderName & d & "\" & fileName

     ActiveWorkbook.SaveAs fileName:=pathName, _
         FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
     ActiveWindow.Close
 End Sub
 中心となる機能をまずは作って、その後、必要に応じて追加していけばよいと思います。

 最初にコメントした「マクロ記録応用編」は以上のとおりです。

 次に、私の質問に頂いた回答に関し、コメントしておきます。
 >1
 ということは、シート3のセルC2  を見てもいいし、見ずにファイル名から取得してもよいということですね。

 >2.ドラッグについて。
 内容、承知しました。

 >3
 >更新時刻が変わるのは問題ございません 
 了解です。杞憂だったようです。

 4.共同作業の分担
 >これらのメールは共有の受信ボックスに届くので、 
 >処理する人がoutlookの(分類項目)に任意の色を付けて処理が被らないようにしております。 
 了解です。

 >5.使用しているメールソフトによっては、メールから直接各フォルダに保存することも可能でしょう。 
   そうした検討はしていますか?する予定はありますか? 
   それともそれは所与のことで検討範囲外ですか? 
 >これはすみません知識不足でよくイメージが湧きません。 
 >中を確認し、フォルダに保存するという2つの工程を漏れなく行えれば良いです。 

 一括して、振り分け処理をしてから、中身を確認することでもよいかなと考えました。
 outlookならそれも可能だと思いますが、これは回答者の趣味に属することだったかもしれません。
 一つずつ確認していくのが固いかもしれません。これ以上は止めておきます。
 (コメントは、以上で終わりです)

 詳細はマリオ様にお願いすることにして、私はここまで、とさせて頂きます。

(γ) 2016/03/05(土) 23:02


 To 田村 さん

 >すみません、これに関してはよくイメージが湧きません。 
 イメージが湧くように、次のプログラムを作成しました。
 田村さんの望んでいるプログラムではありませんが、振り分け作業を楽にしてくれます。
 下記の【はじめに】以降を読んで、試してみてください。

 尚、「A2=\\●●●●\●●●●\2016\3月」(後で説明します)には変更しないで、
 自分のパソコン内だけで、とりあえず試してみてください。

 >『ファイルのクローズと指定のフォルダへの保存が同時に行われるマクロ』が必要だと考えています。
 ファイルを開いてから、内容の確認が済む前に、
 間違って、ファイルをクローズしてしまった場合、またはシステム障害により、ファイルが勝手にクローズした場合、
 確認が済んでないのに保存されてしまう問題が生じます。

 Outlookに自作アドインをインストールして、確認の済んだファイルを閉じた後、
 ファイルが添付してある個別メールのウィンドウをアクティブにして、
 そのウィンドウ上の自作ボタンをワンクリックして、1件1件、自動振り分けするのが簡単なやり方ではありますが。
 >また、アドイン〜、会社では厳しいかと思われます...
 厳しいんですよね。
(マリオ) 2016/03/06(日) 12:17

【はじめに】
 メールソフト上の表示アイコン(確認済みメール添付ファイル)を
 下記で説明しますが、「山本(確認済み)」フォルダにドラッグ&ドロップして、
 とにかく、確認の済んだファイルを「山本(確認済み)」フォルダに溜めていくことを想定しています。
 溜め終わったら、マクロで溜まったファイルを自動振り分け。
 ********************************************************************************
 (1)好きな場所に、「メール添付ファイル」フォルダを作成。
 好きな場所と書きましたが、とりあえず、デスクトップ上に作成してください。
 フォルダ名は、この名前でなくてもOKです。好きな名前に変えて下さい。
 ********************************************************************************
 「(1)のフォルダ」内に、次の(2),(3)を格納。
 (2)自動振り分け(マクロ実行ブック).xlsm
 (3)「山本(確認済み)」フォルダ
 「(2)のファイル名」はこの名前でなくてもOKです。好きな名前に変えて下さい。
 「(3)のフォルダ名」は、変えないでください。適当に山本にしました。
 「(3)のフォルダ」のショートカットをデスクトップに作成しても、いいかも。
 ********************************************************************************
 「(3)のフォルダ」内に、次の(4),(5)を格納。
 (4)AA商事_発注書0306.xlsx
 (5)BB商事_発注書0325.xlsx
 ********************************************************************************
 「(2)のァイル」に「設定」シートを新規作成(シート名:設定)して、次のセルに値入力。
 ★↓Dドライブがない場合は、Cドライブと読み替えて下さい。
 A2=D:\2016\3月
 B2=山本(確認済み)
 A1=移動先フォルダ(上階層)
 B1=移動元フォルダ(最下層)
 ********************************************************************************
 ★↓Dドライブがない場合は、Cドライブと読み替えて下さい。
 (6)Dドライブ上に、「2016」フォルダ作成。
 ********************************************************************************
 「(6)のフォルダ」内に、次の(7)を格納。
 (7)「3月」フォルダ
 ********************************************************************************
 「(7)のフォルダ」内に、次の(8),(9)を格納。
 (8)「0306」フォルダ
 (9)「0325」フォルダ
 ********************************************************************************
 「(2)のァイル」のModule1に次のコードを記述

 Option Explicit
 Sub test1()
     ReDim file(1 To 1) As String, strd(1 To 1) As String
     Dim i As Long, FSO As Object, buf As String, msg As String
     Dim dfr1 As String, dfr2 As String
     Dim sfr1 As String, sfr3 As String
     Dim DEST As String, SOUR As String
     Set FSO = CreateObject("Scripting.FileSystemObject")
     dfr2 = Sheets("設定").Range("A2").Value & "\" '移動先フォルダ(上階層)
     sfr3 = Sheets("設定").Range("B2").Value & "\" '移動元フォルダ(最下層)
     sfr1 = ThisWorkbook.Path & "\" & sfr3 '移動元フォルダ

    '確認
     msg = "自動振り分けしますか?" & vbCrLf & "移動先フォルダ(上階層): " & dfr2
     If MsgBox(msg, vbYesNo + vbQuestion, "確認") = vbNo Then Exit Sub
    '取得
     buf = Dir(sfr1 & "*.xls")'「●●.xls*」(xls,xlsx,xlsm,xlsb,xlshtml)
     Do While buf <> ""
        i = i + 1: ReDim Preserve file(1 To i): ReDim Preserve strd(1 To i)
        file(i) = buf 'ファイル名
        strd(i) = Right(Left(file(i), InStrRev(file(i), ".") - 1), 4) '日付(最後の4文字)
        buf = Dir()
     Loop
    '振り分け
     For i = 1 To UBound(file)
         dfr1 = dfr2 & "\" & strd(i) '移動先フォルダ
         DEST = dfr1 & "\" & file(i) '移動先ファイルのフルパス(Destination)
         SOUR = sfr1 & "\" & file(i) '移動元ファイルのフルパス(Source)
         If Dir(dfr1, vbDirectory) <> "" And Dir(SOUR) <> "" And Dir(DEST) = "" Then
            FSO.MoveFile SOUR, DEST '移動
         End If
     Next i
     Set FSO = Nothing
 End Sub
 ********************************************************************************
 ★↓Dドライブがない場合は、Cドライブと読み替えて下さい。

 マクロを実行すると、マクロ実行ブックと同じフォルダ内にある「山本(確認済み)」フォルダ
 内に格納された、全ての「●●.xls*」ファイルを自動振り分けします。
 移動先フォルダ(上階層)は、「(2)のァイル」の「設定」シートの「A2=D:\2016\3月」

 「●●.xls*」ファイルが、AA商事_発注書0306.xlsxの場合は、
 「D:\2016\3月」フォルダ内の「0306」フォルダに移動します。

 念のために書きますが、CC商事_発注書0415.xlsxの場合は、
 「A2=D:\2016\4月」に変えて下さい(月が変わったため)。

 上のコードで、
 buf = Dir(sfr1 & "*.xls")'「●●.xls*」(対象の拡張子:xls,xlsx,xlsm,xlsb,xlshtml)
 としましたが、
 buf = Dir(sfr1 & "*.xlsx")'「●●.xlsx」(対象の拡張子:xlsx)
 でもいいです。
 ********************************************************************************
 また、共有フォルダでうまくいくか検証はしてませんが、
 「A2=\\●●●●\●●●●\2016\3月」で、うまくいくかな?

 この辺に詳しい、エキスパート様、教えてくださいm(_ _)m

 FSO.MoveFile SOUR, DEST '移動
 自分のPCから共有フォルダへの移動は、問題ないですよね?
(マリオ) 2016/03/06(日) 12:18

 To γ さん
 >詳細はマリオ様にお願いすることにして、私はここまで、とさせて頂きます。
 お疲れ様です。
 解決が難しそうなときは、助けてくださいm(_ _)m
(マリオ) 2016/03/06(日) 12:18

 To 田村 さん

 >『ファイルのクローズと指定のフォルダへの保存が同時に行われるマクロ』が必要だと考えています。

 勘違いしてました。

 エクセルのマクロを実行すると、監視が始まる。
 Outlookが開かれている状態で、かつ、最後の4文字が日付であるxlsxファイルが開かれていたら、
 「Ctrl+F12」(他に影響を与えないショートカットキー)を押すと、
 xlsxファイルが閉じられ、ファイルを振り分ける(共有フォルダの日付フォルダに自動保存)。
 みたいなことですかね。監視、失敗しないかな?

 私には作れません。エキスパートさんの回答を待ちます。
 **********************************************************
 ファイルを置いておきます。
 (ダウンロードパスワード:abc)
 http://ww10.puny.jp/uploader/download/1457248885.zip
 zipファイルを解凍し、「メール添付ファイル」フォルダ内の
 「自動振り分け(マクロ実行ブック).xlsm」を起動して、
 設定シート上の「自動振り分け」ボタン(マクロ実行ボタン)を押してください。

 尚、2016フォルダは、Dドライブ直下ではなく、マクロ実行ブックと同じフォルダ内に変更しています。

 変更点(変更前:1行目、変更後:2行目)
   'dfr2 = Sheets("設定").Range("A2").Value & "\" '移動先フォルダ(上階層)
    dfr2 = ThisWorkbook.Path & "\" & "2016\3月"
(マリオ) 2016/03/06(日) 16:25

 (ダウンロードパスワード:abc)
 http://ww10.puny.jp/uploader/download/1457248885.zip
 上記URL先のサンプルファイルを使用するにあたって。
 「2016」フォルダをマクロ実行ブックと同じ階層に置いてください。

 ★詳細
 ********************************************************************************
 (6)、「メール添付ファイル」フォルダ内のマクロ実行ブックと同じ階層に、「2016」フォルダ作成。
 ********************************************************************************
 「(6)のフォルダ」内に、次の(7)を格納。
 (7)「3月」フォルダ
 ********************************************************************************
 「(7)のフォルダ」内に、次の(8),(9)を格納。
 (8)「0306」フォルダ
 (9)「0325」フォルダ
 ********************************************************************************

(マリオ) 2016/03/06(日) 16:34


こんにちは。

マリオさん、誤解しておられますよ(^^
田村さんのご希望は、作業の効率化とコードの理解です。
ファイル名以外、こういう仕様でないと絶対にダメということはないはずです。
outlookの監視は回答者の趣味の領域です。

>『ファイルのクローズと指定のフォルダへの保存が同時に行われるマクロ』が必要だと考えています。
開いているエクセルファイルをしかるべく保存して 閉じるマクロ、ということですね、これは。
マリオさんは能力がお高くてらっしゃるので、難しく考えすぎなのでしょう。

>エクセルのマクロを実行すると、監視が始まる。
田村さんが将来的にご自身でコードを書けるようになられたら
outlookのVBAで、メール着信イベントのコードを書かれたらいいと思いますね。
いまは、アクティブなブックを保存して閉じるで十分ではないですか。

( 佳 ) 2016/03/06(日) 19:15


 To 佳 さん

 こんばんわ(^^♪

 >outlookの監視は回答者の趣味の領域です。 
 監視するのは、やりすぎですね。わざと、難しく考えて遊んでます(^^♪

 【他の案】
 OutlookのVBA(Module1)に、設定内容を含めたコードを書いておく。
 ■通常の操作
 Outlookを開く→「Alt+F8」でマクロ一覧を出して、マクロを選択して実行。

 すると、添付ファイル上で右クリックしたときに表示されるメニュー
 (プレビュー〜すべて選択)の下に(振り分ける)のメニューが一時的に追加される。

 Outlookを終了させると、終了させる前に追加メニューを削除するようにする。
 みたいな感じはどうですかね。(開いたxlsxファイルは手動で、事前に閉じておく。)

 ちなみに、Outlook にVBのコード書き込んだことありません。
 そもそも、Outlookの添付ファイルは、何処に保存されているんでしょう?(^^♪
(マリオ) 2016/03/06(日) 21:29

γ様
コードの記載大変助かりました。
本当に有難うございます。
自分としてもこのコードの意味が理解出来たので早速会社で試してみたのですが、なぜか
     d = Format(Worksheets("Sheet3").Range("C2").Value, "mmdd")
この部分で"インデックスが有効範囲にありません"とデバッグになります。

きちんと("\\****\****\2016\3月\")の部分を会社のパスに変え、
マクロ実行ブックを作り、それを開いた状態でメールに添付されたファイルを開き、実行したところ
ダメでした。どういった原因が考えられますでしょうか?
もしまだこちらをご覧になられていましたら教えてください。

マリオ様
zipファイルまでくださり本当に有難うございます。
試してみたところ、仰る通りの振り分けが出来ました。
正直なところこれは業務フローが少々変わるので会社で使わせてもらえるかはわからないですが、
今後の運用次第では是非とも使わせて頂きます。

マリオ様 佳様
お気遣い有難うございます。
ちょっと私には高度すぎてどういった議論がなされているかわからないです。
"outlookの監視"という言葉も初耳でした。
(田村) 2016/03/07(月) 02:59


こんにちは。

マリオさん。
田村さんのご希望には、コードの理解も含まれています。
難しいコードは結構ですが、それをどのように理解させるか
さきに考えておかないとイカンだろうと思います。

田村さん
>"outlookの監視"という言葉
ああ、ただの日本語です。
メールが届いたらすぐ気がつくように、ずーっとアウトルックを見張っている
というていどの意味です。気にしないでください。

それより、マクロを動かした結果うまく行かなかったときは、単に「ダメでした」
だけではなく、どこがどう期待と違うのかしっかり確認して説明しなくっちゃ
です。

( 佳 ) 2016/03/07(月) 06:58


原因としては、Sheet3というシートが無いから、ということでしょうね。

シート名が変わっているなら、
ブック名の日付文字列がきちんと挿入されていることを前提に

     fileName = ActiveWorkbook.Name
     D = Left(Right(fileName, 9), 4)
などとしてもよいでしょう。

リスクは、全角半角などが混入していないかです。
StrConv関数で半角に統一するなど検討してください。
なお、ActiveWorkbook.Closeのほうが自分の趣味には合います。

To マリオさん
>そもそも、Outlookの添付ファイルは、何処に保存されているんでしょう?
Excel Q&Aサロンの最近の投稿「メールに関して」を参考にしてみてください。

(γ) 2016/03/07(月) 07:20


 失礼します

 To マリオさん

 >> 監視するのは、やりすぎですね。わざと、難しく考えて遊んでます(^^♪

 マリオさんの、このスタンス、他の板でも同様ですけど、個人的には嫌いじゃありません。
 でも、Q/Aサイトでの Q に対する A としては、適切かどうか。

 体育館でイベントがあって、そこにいくために道を尋ねた人に、そのエリアの情報誌を渡し
 もっと楽しいことがてんこ盛りだよと、たしかに、その情報誌のどこかをさがせば、体育館のイベントのことも
 ちょこっとは書いてあるわけですが、まずは、道を教えてあげることが先決かなと。

 【学校】の場合、編集で、アップ済みコメントを訂正しようとしたときに、そのトピの今までのすべてのQ/Aの内容が
 アップ対象になり、ブラウザの制限で、文字数オーバになって編集が使えなくなることが少なくありません。

 とくにマリオさんが書きこんだあとは、たちどころに文字数制限オーバになってしまうケースが多いかな・・・

(β) 2016/03/07(月) 07:30


 To 田村さん

 2016/03/06(日) 12:18の 【tset1()のコード】(zipファイルのコード)
 理解されましたでしょうか?分からない箇所がありましたら、おっしゃってください。
 佳 さんにお叱りを受けましたので(^^♪βさんからも(^^♪
 まずは、そこから始めるべきですね。解決なら、これで終了しますが。

 ファイル名の最後の4文字である日付【例:0306】は必ず半角数字であり、
 移動先のフォルダ【例:0306】も必ず半角数字であることを前提としています。
 どちらかが、半角数字でなくて、全角なら、
 StrConv関数で半角に統一するなどを検討しなくてはいけません。
 γさんがおっしゃていたことをリピートしてます(^^♪
 検討対象コードは、次のコードです。
 strd(i) = Right(Left(file(i), InStrRev(file(i), ".") - 1), 4) '日付(最後の4文字)

 To γさん
 >Excel Q&Aサロンの最近の投稿「メールに関して」を参考にしてみてください。 
 そんな記事あるんですか、私個人の趣味として見てみます!(^^)!ありがとうございます。

 To エキスパートの皆様方
 tset1()のコード、、
  「A2=\\●●●●\●●●●\2016\3月」と移動先フォルダを共有フォルダにした場合、
  うまく動作しますでしょうか?
  FSO.MoveFile SOUR, DEST '移動
  自分のPCから共有フォルダへの移動は、問題ないですよね?
(マリオ) 2016/03/07(月) 10:14

佳様 β様
ご助言、ご配慮有難うございます。
ここでの色々な質問や回答を見本にしながら勉学に励みたいと思います。

γ様
仰る通りsheet3が存在しなかったことが原因でした。
私の勘違いで3枚目のシートは名前がどのようなものでも"sheet3"で動くと思っていました。
フォーマットは各社一緒なので正しい名前に修正し、動きました。
本当に長い間面倒を見て頂いて有難うございました。感謝致します。

マリオ様
頂いたコードを理解するのは時間がかかりそうです。
仕事が一段落しそうなのでこれから少しずつ解読していこうと思っています。
マリオ様にも本当に親切にして頂き感謝しております。有難うございます。
(田村) 2016/03/09(水) 20:57


ついで。
>3枚目のシートは名前がどのようなものでも"sheet3"で動くと思っていました。
それなら、Worksheets(3)とすると良い。
(γ) 2016/03/09(水) 21:11

コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.