質問: VBA素人です VBAがエクセルの内部において作業できるのは分かっているのですが 今回の質問は、エクセルの中に仕様を組み、 エクセルの外部に指示をしたいのですができるのでしょうか (まったくわからずに質問します・・・) できる!となれば、重ねて質問させていただくようになろうかと思います よろしくお願いいたします。 フォルダー内に保管してあるファイル(エクセル・ワードやPDFなど)のうち 必要なものだけをチョイスしてメール送信する作業を簡素化したいです ここでは、料理に例えます キャベツ入りのペペロンチーノのレシピの資料送信依頼を受けたとします 必要なもの ・レシピ表(全体が書かれているもの) ・材料カタログ キャベツやニンニク、パスタ(今回は3つだとします) 現在の作業(VBAに簡素化したい内容) 資料の送信依頼を受けたのちに ・新規でフォルダー作成 ・フォルダーに名前を付ける「キャベツ入りのペペロンチーノ」(以後A) ・レシピ表をフォルダーから探す ・レシピ表を「A」にコピペ ・レシピ表を「A」を見て、使用している材料を3つ確認 ・3つの材料カタログをフォルダーから探す ・材料カタログを「A」にコピペ ・「A」の中身があっているかを確認 ・「A」を圧縮する ※ 材料が3つくらいなら、事前に用意しておきたいのですが 作業をする時期によって、生産者や産地が変わるなどの理由で カタログが最新のものに更新されてしまい、かつ 材料は他のレシピに共通するために、マスターデータを1か所で 管理する必要があるために困難と考えています なので、このような作業が減りません。。。 現状下記の要領を検討しています。 不足事項などありましたら、ご指摘いただけると幸いです。 検討中の仕様 ・エクセルファイルの保管場所 決まっていません。都度自分の居場所のパスを取得したいです。 ・レシピと材料カタログの保管位置 エクセルと同じフォルダーか、フォルダー内に 野菜・魚介などのフォルダーを作成し保管する予定です。
回答: 昨日疑問点を書いて回答しましたが返信がなかったので、回答し直します。 材料は各分類フォルダに入るpdfファイルという事はわかりますが レシピ表をがどこにある何のファイルなのかわかりません。 料理名フォルダの下にある、エクセルファイルとします。 新規に作成するフォルダは選択方式です。 貴方が添付した画像の上部分がこのマクロを入れるエクセル表とします。 分類の列が必要なので追加して下さい。 下記マクロはフォルダに必要ファイルを入れるところまでです。 Sub Macro() Dim dname As String Dim rng As Range Dim ppath As String Dim mpath As String Dim fpath As String Dim fname As String Dim rmax As Long Dim r As Long, c As Long '料理名入力 dname = InputBox("料理名を入力してください。") If StrPtr(dname) = 0 Then Exit Sub ' キャンセル時に終了 With ActiveSheet Set rng = .Cells.Find(What:=dname, LookIn:=xlValues, LookAt:=xlWhole) If rng Is Nothing Then MsgBox "その料理は登録されていません" Exit Sub End If End With '出力フォルダ選択 With Application.FileDialog(msoFileDialogFolderPicker) If .Show = False Then Exit Sub ppath = .SelectedItems(1) & "\" End With Application.ScreenUpdating = False Application.DisplayAlerts = False 'フォルダ作成 If Dir(ppath & dname, vbDirectory) = "" Then MkDir ppath & dname End If mpath = ThisWorkbook.Path & "\" 'レシピファイル fpath = mpath & "料理名\" If Dir(fpath & dname & ".xlsx") = "" Then MsgBox "dnameのレシピは登録されていません" Exit Sub End If FileCopy fpath & dname & ".xlsx", ppath & dname & "\" & dname & ".xlsx" 'コピー '材料ファイル rmax = Cells(Rows.Count, 2).End(xlUp).Row r = rng.Row + 1 c = rng.Column fpath = mpath & "材料名\" Do Until (Cells(r, c).Value <> "" And Cells(r, c).Value <> "○" And Cells(r, c).Value <> dname) Or r > rmax If Cells(r, c).Value = "○" Then fname = fpath & Cells(r, 3).Value & "類\" & Cells(r, 2).Value & ".pdf" If Dir(fname) = "" Then MsgBox "材料" & Cells(r, 2).Value & "は登録されていません" Exit Sub End If FileCopy fname, ppath & dname & "\" & Cells(r, 2).Value & ".pdf" 'コピー End If r = r + 1 Loop Application.DisplayAlerts = True Application.ScreenUpdating = True MsgBox dname & "フォルダを作成し必要なファイルを入れました" End Sub