エクセルVBAで保存がうまくいきません

質問

エクセル2000です。
下記のようなVBAを記述しました。
「はい」なら別名保存
「いいえ」なら上書き保存のつもりです。

問題点
Sheets("AAA").Range("I9")の文字列内に.(半角ピリオド)があるとファイルに拡張子がつきません。
どうしたらよいのでしょうか？非常に困っています。

Sub 保存ボタン()
Dim myYN As Integer
Dim DRtn As Boolean
Dim fn As String, fn2 As String
fn = Sheets("AAA").Range("I9").Value & "_保存"
fn2 = ThisWorkbook.Name

myYN = MsgBox("現在の入力内容を別名で保存しますか？" _
+ Chr(&HD) + Chr(&HA) + "別名保存なら「はい」" _
+ Chr(&HD) + Chr(&HA) + "上書保存なら「いいえ」を選択します。" _
+ Chr(&HD) + Chr(&HA) + "", vbYesNoCancel + vbQuestion, " 別名保存")

If myYN = vbCancel Then Exit Sub 'キャンセルなら終了
If myYN = vbNo Then fn = fn2 '上書保存ならファイル名はそのまま

DRtn = Application.Dialogs(xlDialogSaveAs).Show(ARG1:=fn, ARG2:=1)
If DRtn = False Then Exit Sub 'ファイル名を消されたらキャンセル
ThisWorkbook.Save '保存
ThisWorkbook.Close '閉じる
End Sub

回答No.2

taocat · ベストアンサー

こんにちは。

fn = Sheets("AAA").Range("I9").Value & "_保存"

この　"_保存"　に　".xls"　を加えてみてください

fn = Sheets("AAA").Range("I9").Value & "_保存.xls"

以上です。

お礼

え？こんな簡単なことで解決しちゃうんですか？！
ありがとうございます。

回答No.3

KenKen_SP

こんにちは。KenKen_SP です。

xlDialogSaveAs に引数で渡す保存ファイル名に拡張子をつければいけると
思います。

また、xlDialogSaveAs で OK がクリックされると保存されますので、改めて
Save メソッドを実行する必要はありません。

余談ですが、MsgBox の Prompt の部分で文字列の連結に(+)演算子が使われて
いますが、(&)演算子を使うべきです。

(+)演算子は、その前後両方の演算項目が String 型ならば、文字列の連結と
して作用しますが、数値型と文字列型を連結させようとするとエラーとなり
ます。

Sub 保存ボタン()

　　Dim myYN As Integer
　　Dim DRtn As Boolean
　　Dim fn　 As String, fn2　 As String

　　fn = Sheets("AAA").Range("I9").Value & "_保存.xls" '<-- 拡張子追加
　　fn2 = ThisWorkbook.Name

　　myYN = MsgBox("現在の入力内容を別名で保存しますか？" _
　　& Chr(&HD) & Chr(&HA) & "別名保存なら「はい」" _
　　& Chr(&HD) & Chr(&HA) & "上書保存なら「いいえ」を選択します。" _
　　& Chr(&HD) & Chr(&HA) & "", vbYesNoCancel Or vbQuestion, " 別名保存")

　　If myYN = vbCancel Then Exit Sub 'キャンセルなら終了
　　If myYN = vbNo Then fn = fn2 '上書保存ならファイル名はそのまま
　　DRtn = Application.Dialogs(xlDialogSaveAs).Show(ARG1:=fn, ARG2:=1)
　　If DRtn = False Then Exit Sub 'ファイル名を消されたらキャンセル
　　ThisWorkbook.Close '閉じる

End Sub

お礼

ありがとうございます。無事解決しました。

> xlDialogSaveAs で OK がクリックされると保存されますので、改めて
> Save メソッドを実行する必要はありません。

あ、な～るほど！言われてみればそうですね。
ご指摘ありがとうございました。

> MsgBox の Prompt の部分で文字列の連結に(+)演算子が使われて
> いますが、(&)演算子を使うべきです。

これまで何の疑問も持たず、改行の場合こう書いてきました。
ご教示ありがとうございました。

回答No.1

moooon

ファイル名にする文字列中に半角ピリオドがあると、エクセルはそれ以降の文字列を拡張子と判断するのでそういうことが起きるのだと思います。
最初から文字列中の半角ピリオドを削除しましょう。
こんな感じでどうですか？

Sub 保存ボタン()
Dim myYN As Integer
Dim DRtn As Boolean
Dim fn As String, fn2 As String
fn = Sheets("AAA").Range("I9").Value & "_保存"
fn1 = Application.WorksheetFunction.Substitute(fn, ".", "")'ピリオド削除
fn2 = ThisWorkbook.Name

MsgBox fn1

myYN = MsgBox("現在の入力内容を別名で保存しますか？" _
+ Chr(&HD) + Chr(&HA) + "別名保存なら「はい」" _
+ Chr(&HD) + Chr(&HA) + "上書保存なら「いいえ」を選択します。" _
+ Chr(&HD) + Chr(&HA) + "", vbYesNoCancel + vbQuestion, " 別名保存")

If myYN = vbCancel Then Exit Sub 'キャンセルなら終了
If myYN = vbNo Then fn1 = fn2 '上書保存ならファイル名はそのまま

DRtn = Application.Dialogs(xlDialogSaveAs).Show(ARG1:=fn1, ARG2:=1)
If DRtn = False Then Exit Sub 'ファイル名を消されたらキャンセル
ThisWorkbook.Save '保存
ThisWorkbook.Close '閉じる
End Sub

お礼

さっそくありがとうございます。

たしかにピリオド削除でうまくは行くのですが、そうすると別の問題（エクセルとは別ですが）が発生するのです。

というのはSheets("AAA").Range("I9")に入力されるのは企業名なんです。
それも英文で、ABC Inc.(エイビイシイ インク)というような入力なのです。

会社名からは、たとえピリオドといえども一部を削除できないんですよ～。

補足

ピリオドがついた名前でエクセルのファイル保存ができないのであればそう説明して納得させるのですが、手入力の場合はABC Inc.(エイビイシー インク).xlsで保存できますので困っちゃうんです。