[[20100311174616]]　『IF文を使っての保存』（うさぎさん）　ページの最後に飛ぶ

『IF文を使っての保存』（うさぎさん）

 こちらで下記のような、コードをご教授いただいたのですが、
DTPath = WSH.SpecialFolders("Desktop") などをしようして、デスクトップのパスを
 取得して、もしデスクトップ上に作業フォルダというフォルダがある場合、その中へ保存し、そうでない場合は作業フォルダを作成して保存という感じにはできませんでしょうか？

 ＿＿＿＿＿＿＿＿＿
 Sub SaveWS() 
    Dim savePath As String 
    savePath = ThisWorkbook.Path & "\作業フォルダ\" & ActiveSheet.Name & "(" & ActiveSheet.Range("E5").Value & ")" & ".xls"

    If Dir(ThisWorkbook.Path & "\作業フォルダ") = "" Then   
     MkDir ThisWorkbook.Path & "\作業フォルダ" 
 End If

    ActiveSheet.Copy 
    ActiveWorkbook.SaveAs savePath 
    ActiveWorkbook.Close 
    MsgBox savePath & vbNewLine & "を保存しました。" 
 End Sub 
 　
[[20100310162811]]　『エクセルマクロ　名前を付けて保存について』（うさぎさん）
 ＿＿＿＿＿＿＿＿＿
よろしくお願いします。

 savePath ・・・・の前に

 DTPath = CreateObject("Wscript.Shell").SpecialFolders("Desktop")

 として、上のコードのThisWorkbook.Pathの部分をDTPathにすれば出来ると思います。
 （ｍｏｍｏ）

momo様

 教えていただいたとおり、下記のように書き換えましたが、「コンパイルエラー　変数が定義されておりません」と出てしまいます。
 対処法がおわかりになりましたら、よろしくお願いします。（うさぎさん）

＿＿＿＿＿＿＿＿＿＿＿

 Sub SaveWS()

    Dim savePath As String
    DTPath = CreateObject("Wscript.Shell").SpecialFolders("Desktop")
    savePath = DTPath & "\作業フォルダ\" & ActiveSheet.Name & "(" & ActiveSheet.Range("E5").Value & ")" & ".xls"

    If Dir(DTPath & "\作業フォルダ") = "" Then   
     MkDir DTPath & "\作業フォルダ"
 End If

    ActiveSheet.Copy
    ActiveWorkbook.SaveAs savePath
    ActiveWorkbook.Close
    MsgBox savePath & vbNewLine & "を保存しました。"
 End Sub

＿＿＿＿＿＿＿＿＿＿

 その名のとおりのエラーですので変数を定義してあげればよいです。
 宣言されていない変数はDTPathですので
 Dim DTPath As String
 を追加してみてください。
 （ｍｏｍｏ）

momo様

 ありがとうございます。新規にフォルダを作って（デスクトップ上に作業フォルダがない場合）、保存する場合はちゃんと動くのですが、
 すでに、作業フォルダをが作成してある場合、（最初で質問させていただきました、もしデスクトップ上に作業フォルダというフォルダがある場合、
 その中へ保存し、そうでない場合は作業フォルダを作成して保存したい）
 は、実行時エラー７５　パス名が無効となってしまいます。

 なにか対処法がございましたら、なにとぞよろしくお願いします（うさぎさん）

 F8キーでステップ実行すると原因がわかると思います。

 作業フォルダがあってもなくても
 >If Dir(DTPath & "\作業フォルダ") = "" Then
 この判定を通過してしまいませんか？
 「\作業フォルダ」となっているので「作業フォルダ」というファイルを探しているため
 当然無いので通過してフォルダを作ろうとしてしまいます。

 If Dir(DTPath & "\作業フォルダ\") = "" Then
 　　　　　　　　　　　　　　 ~~~
 のように「\作業フォルダ\」と最後に￥をつけてフォルダ名をチェックするのだという事を
 Excel君に教えてあげれば希望どおりになると思いますよ。
 （ｍｏｍｏ）

momo様

 ありがとうございました。希望通りの動きができました。

 同じ名前のファイルがある場合、置き換えますか？というポップアップがでると思うのですが、
 その時に「いいえ」を選択すると、実行時エラー1004　saveAZメソッドが失敗しましたworkbookオブジェクトとでるのですが、同じブックがあり置き換えますか？でいいえを選択したら、
 なにもエラーがでないようにはできませんでしょうか？

 いいえと押すと互換モードという同じファイルのエクセルが立ち上がってしまうのですが、これはなんでしょうか？（T０T）
 何度も申し訳ありませんがおわかりになりましたらぜひよろしくお願いします（うさぎさん）

 Dir関数の使い方を知ってらっしゃるようですので、
 同じように事前にチェックして判定させてみてはどうでしょうか？

 Sub SaveWS()

 Dim savePath As String
 Dim DTPath   As String
 DTPath = CreateObject("Wscript.Shell").SpecialFolders("Desktop")
 savePath = DTPath & "\作業フォルダ\" & ActiveSheet.Name & "(" & ActiveSheet.Range("E5").Value & ")" & ".xls"

 If Dir(DTPath & "\作業フォルダ\") = "" Then
     MkDir DTPath & "\作業フォルダ"
 End If

 If Dir(savePath) <> "" Then
     If MsgBox("同じファイル名が存在します。上書き保存しますか？", vbYesNo + vbExclamation) = vbNo Then
         MsgBox "保存を中止しました。"
         Exit Sub
     End If
 End If
 ActiveSheet.Copy
 ActiveWorkbook.SaveAs savePath
 ActiveWorkbook.Close
 MsgBox savePath & vbNewLine & "を保存しました。"

 End Sub

 （ｍｏｍｏ）

momo様

 どうもありがとうございます。しっかり動きました。
 １点、ご相談なのですが、同じファイル名が存在します。上書き保存しますか？とでてきて、「はい」
 を選択したら以前出てきた、置き換えますか？のポップアップが出て再度「はい」とクリックしなければならないのですが、
 これをなんとかすっきりと、する方法はございませんでしょうか？よろしくお願いします（うさぎさん）

 >ActiveSheet.Copy
 >ActiveWorkbook.SaveAs savePath
 >ActiveWorkbook.Close
 >MsgBox savePath & vbNewLine & "を保存しました。"

 の部分を

 Application.DisplayAlerts = False '★追加
 ActiveSheet.Copy
 ActiveWorkbook.SaveAs savePath
 ActiveWorkbook.Close
 Application.DisplayAlerts = True '★追加
 MsgBox savePath & vbNewLine & "を保存しました。"

 にしてください。
 （ｍｏｍｏ）

momo様

 感動です。やっとできましたー。お世話になりました。どうもありがとうございました＾０＾（うさぎさん）

コメント返信：

[ 一覧(最新更新順) ]

[[20100311174616]] 『IF文を使っての保存』（うさぎさん） ページの最後に飛ぶ

[[20100311174616]]　『IF文を使っての保存』（うさぎさん）　ページの最後に飛ぶ