エクセルでセル内容でフォルダを作って保存

質問

今はマクロボタンをクリックすると特定のセルの内容で指定したフォルダにＰＤＦで保存されるようにして使っているのですがその前段取りが結構手間がかかって間違いも多いので改良したいのです。
やりたいことは、
決まった名前（見積書）のシート上のセルの内容（顧客名）で、例えばデスクトップの決まったフォルダ（見積書）の中に、Ａ１セルの内容（顧客名）でフォルダを作成し、セルＢ２＋Ｃ３の内容（日付＋見積Ｎｏ）をファイル名にＰＤＦで保存する、ということは出来るのでしょうか？

更にＡ１(顧客名）が同じなら既存の顧客フォルダにＢ２＋Ｃ３で保存したいのですが。。。
かなり贅沢な要求だと思いますが、もし可能であればよろしくお願いします。

回答No.2

HohoPapa · ベストアンサー

・デスクトップに"見積書"フォルダーがある。
・１つのブックに複数のシートがある。
・その１つのシートの名前が"見積書"。　　※3
・出力する対象シートが※3
・このシートのA1セルに出力するフォルダー名が埋まっている　※1
・B2,C3にファイル名が埋まっている。　　 ※2
・※1が無かったら作成する。
・※2があったら上書きする。
という理解でいいですか？

ならば、

Option Explicit

Sub MakePdf()

　Const OyaDir = "C:\Users\papa\Desktop\見積書"　'出力先親フォルダー
　Dim PutDir As String
　Dim FromSh As Worksheet
　Dim PutFile As String

　'対象シートを特定
　Set FromSh = ThisWorkbook.Sheets("見積書")

　'出力先フォルダーの組み立て、なければ作成
　PutDir = OyaDir & "\" & FromSh.Cells(1, 1).Text
　If IsExistDirA(PutDir) = False Then
　　MkDir PutDir
　End If

　'出力先ファイル名を組立て出力
　PutFile = PutDir & "\" & _
　　FromSh.Cells(2, 2).Text & _
　　FromSh.Cells(3, 3).Text & ".pdf"
　FromSh.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PutFile

End Sub

Function IsExistDirA(a_sFolder As String) As Boolean
　Dim result
　result = Dir(a_sFolder, vbDirectory)
　If result = "" Then
　　IsExistDirA = False
　Else
　　IsExistDirA = True
　End If
End Function

でいかがでしょうか。

お礼

完璧です！！
昨日は何度か試してみて動かず。
既存のマクロを削除したり、シート名や指定セルを色々・・・

でも過去のHohoPapaさんの実績から、きっとコードは正しいはず、と思って今日改めて思考錯誤して動きました。
ダミーシートでセルやフォルダ名を質問の通りにしてみたら一発で動きました。

そこで改めて、会社のサーバのパスに置き換えて、セルも確認したら期待通りに動くことを確認しました。
（わかりやすい解説のおかげ）

回答No.4

SI299792

＞最初はこんな数行で
　実はデスクトップだと楽なんです。サーバやクラウドがあり得ないから。
　最近サーバの事がよくありますが、質問者はサーバがどうか書いてくれません。サーバの可能性を考慮してプログラムを作らなければなりません。
　と思ったら、今度はクラウドで誤動作した事ありました。そこまで考慮できません。（クラウトまで考慮してプログラムを作ったら効率が落ちます）
（愚痴です）

お礼

解決したので早々にＢＳを決めて締め切らないといけないのですが、2番目のご回答と非常に迷いましたが、汎用性を考慮してHohoPapaさんにさせていただきます。

SI299792さんのご回答は当方の要求事項を完全に満たしており、かつ一番最初にご回答いただいているのですが汎用性を考慮して2番目のご回答にさせていただきますのでご了承ください。

こちらの質問の仕方が悪かっただけですので、本当に申し訳ありませんがご容赦！

補足

やはり作る人からするとデスクトップが扱いやすいのですね。
過去にもここで色々教えてもらっており、素人なのでご指摘の通り場所を指定しないで質問するとデスクトップを例にしたコードをご回答いただくのですが、それを実際のサーバーに変えるのに大きく手間取ったことがあります。

逆にその経験から、DEST TOPで作っていただければと思ったのですが、ご回答は（感動するほど）あまりにシンプルで最初に
ChDrive "C:"
これをどうするのか？でしたが、HohoPapaさんのご回答で解決しました。

但し、現在のサーバのフォルダ構成がこのシステムにあっていないので当分はデスクトップで使用させていただき、フォルダをサーバーに移動する時にはHohoPapaさんのコードを使うことにしたいと思います。

回答No.3

imogasi

質問の趣旨（この業務の目的）がわかりにくい。
質問には、丸投げしているのだから、問題のシートの一部（A,B,C列など、１０行程度）を載せて質問してほしい。
・顧客別の見積書の目録のようなものを作りたいのか？
・同一顧客宛の見積書は、（多分、月が違うのだろうが）同じフォルダーに入れておきたいのか？
・請求書の、発出は随時か、毎月（定例）か？
　＞Ａ１(顧客名）が同じなら・・は、時期が違う見積書か？その得意先名フォルダに得意先＋年月などのファイル名で、収納するなどを想定しているのか。
・もし、毎月の見積書の実物コピーをもつならば、フォルダーに持たない方がよいのでは。
必要があれば元データから、その場でイメージを作成するとか。１，２か月分に
限定するとか。
ーー
デスクトップにアイコンがあるとはいえ、デスクトップ（アイコン）がごちゃごちゃして、良くないのでは。数が多くなると、探すのが、むつかしくなるように思う。
ーー
目録的な、例えば、後日問合せや、調査のためのものなら、もっと得意先名を一覧化した表的なものを（１ファイルに）作る方がよいのでは。
ファイルを別にすると、VBAでは扱いが、より複座地下する。
ーー
また、見積書の書式（実物）イメージで保存するのではないようだが、なぜPDFで保存するのか。
ーー
マクロなんて言っているところや、発想がどうも経験の少ない人が、思い付きで質問しているように思えてならない。近くに相談できる人が必要と思う。
　まだ会社の通常業務をプログラムで、処理するのは無理があるのでは？
ーー
デスクトップにフォルダを作る、なんてWEB照会すれば記事がむつかる。
Googleで「vba デスクトップ　フォルダ作成」で照会すれば記事が出る。
１例は　http://officevba.info/specialfolder/
ーー
Sub デスクトップに「あいうえお」名のフォルダを作成するマクロ()
Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
FSO.CreateFolder "C:\Users\XXX\Desktop\あいうえお"
Set FSO = Nothing
End Sub
XXXは質問者の場合のユーザー名に置き換えること。
削除は
Sub test01()
Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
FSO.DeleteFolder "C:\Users\XXX\Desktop\あいうえお"
End Sub

お礼

早々のご回答ありがとうございました。
非常に参考になりました。

回答No.1

SI299792

デスクトップに「見積書」フォルダは必ずあるのですね。
VBA に不可能はありません。
'
Sub Macro1()
'
　　ChDrive "C:"
　　ChDir CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\見積書"
　　On Error Resume Next
　　MkDir [A1]
　　On Error GoTo 0
　　ActiveSheet.ExportAsFixedFormat xlTypePDF, [A1] & "\" & [B2] & [C3]
End Sub

\ はコピペすれば￥になります。そのままにして下さい。

お礼

早々のご回答ありがとうございます。

最初はこんな数行で新規にフォルダ作成して、ファイル名つけて、かつ既存のフォルダがあればその中に保存までが満たされるハズがない、と思いながらせっかくご回答いただいてので、試すだけはと思い試したところやっぱり駄目でした。
が、良くやるミスでセル番地の指定をしておらず。

セルを修正したところ何故か完璧に動きました！！！
不思議で気持ち悪いですが早速使わせていただきます。