ｘｌｓ形式で保存したい

Question

前提・実現したいこと

エクセルファイルをxls形式にて保存したい

発生している問題・エラーメッセージ

・発生している問題
VBAで保存したファイルだけ、
アイコンが白くなっている。
メールに添付もできない。
同じPCで、
VBAを使わずに保存すると
ちゃんと緑のアイコンで保存される。

以上の事からVBA原因ではないかと思い、
質問させて頂きます。

どこか誤りがございましたら、ご教授お願い致します。

VBA

Sub 請求書番号と日付を名前にしてxls形式にて保存()
    Dim FileName As Variant
              
    FileName = Application.GetSaveAsFilename(InitialFileName:=Range(請求書番号のセル) & Format(Date, "ddmmyyyy"), FileFilter:="Excelファイル,*.xls*")
    If FileName = False Then
        Exit Sub
    End If
    ActiveWorkbook.saveas FileName
End Sub

試したこと

いくつかのサイトを調べました。

https://pcclick.seesaa.net/article/461444208.html

https://jisaku-pc.net/hddhukyuu/archives/5803

https://answers.microsoft.com/ja-jp/msoffice/forum/msoffice_excel-mso_winother-mso_2010/%E3%82%A8%E3%82%AF%E3%82%BB%E3%83%AB%E3%81%AE/5cd0bbd6-e5b6-422c-8ff4-9971218528af

Comments

[meg_]

> いくつかのサイトを調べました。
回答が重複すると無駄なのでサイトのURLを提示してください。

[junkij]

megさん
失礼いたしました。
以下の3サイトです。

https://pcclick.seesaa.net/article/461444208.html

https://jisaku-pc.net/hddhukyuu/archives/5803

https://answers.microsoft.com/ja-jp/msoffice/forum/msoffice_excel-mso_winother-mso_2010/%E3%82%A8%E3%82%AF%E3%82%BB%E3%83%AB%E3%81%AE/5cd0bbd6-e5b6-422c-8ff4-9971218528af

Answer 1

拡張子が付いていないのが原因かと思われます。
下記でどうでしょうか？

FileName = Application.GetSaveAsFilename(InitialFileName:=Range("A1") & Format(Date, "ddmmyyyy") & "xls", FileFilter:="Excelファイル,*.xls*")

Comments

[hatena19]

ドットが不足してませんか。

Format(Date, "ddmmyyyy") & ".xls"

[meg_]

当方の環境では「.」を付けると正しく動作しませんでしたので回答の通りとしました。（Windows8.1、Excel2013）　※質問者さんの環境が未記載のため自環境での結果を記入しました。
hatena19さんが検証された環境は何でしょうか？参考のため教えてください。

[hatena19]

「.」を付けないと、「請求書番号20082020xls」というような拡張子のないファイル名になりました。
環境は、Windows10 Excel2019 です。

[hatena19]

ちなみに、, FileFilter:="Excelファイル,*.xls" というようにフィルタを xls 固定にすると、
「請求書番号20082020xls.xls」というファイル名になりました。

[meg_]

そうなんですね！ 当方の環境では「.xls」を付けると、ダイアログのファイル名（初期値）が表示されませんでした。環境によって異なるんですね。

[junkij]

ドットをいれたら解決しました。
ありがとうございました

[junkij]

Windows7
Excel 2010?
でした。

[junkij]

FileName = Application.GetSaveAsFilename(InitialFileName:=Range(請求書番号のセル) & Format(Date, "ddmmyyyy") & ".xls", FileFilter:="Excelファイル,*.xls*")
If FileName = False Then
Exit Sub
End If
ActiveWorkbook.saveas FileName

としてみたところ、緑のアイコンで保存され、メールに添付も可能になりましたが、質問欄に追加した画像のようなエラーが出てしまいました。取引先に送る関係で、このようなエラーもなくしたいのですが、もしこちらの解決法もご存じであればご教授頂けますでしょうか。

[junkij]

こちら解決しました！ありがとうございました

Answer 2

Sub 請求書番号と日付を名前にしてxls形式にて保存()
    Dim FileName As Variant

    FileName = Application.GetSaveAsFilename(InitialFileName:=Range(請求書番号のセル) & Format(Date, "ddmmyyyy"), FileFilter:="Excelファイル,*.xls")
    If FileName = False Then
        Exit Sub
    End If
    ActiveWorkbook.SaveAs FileName:=FileName, FileFormat:=xlExcel8
End Sub

Comments

[junkij]

radamesさん
ご回答ありがとうございます。
試してみます

[radames1000]

こちら試していただくと追加のエラーも出ないと思います

[junkij]

追加のエラーも解決しました

無知な質問で申し訳ございません
FileFormat をxlExcel8 (=Excel 97-2003 ブック)
と指定したことによってエラーが解決したのでしょうか

[radames1000]

はい、その通りです。

[junkij]

すいません

ご教授頂きありがとうございました。

Answer 3

Sub 請求書番号と日付を名前にしてxls形式にて保存()
    Dim FileName As Variant

    FileName = Application.GetSaveAsFilename(InitialFileName:="999999" & Format(Date, "ddmmyyyy") & "xls", FileFilter:="Excelファイル,*.xls")
    If FileName = False Then
        Exit Sub
    End If
    ActiveWorkbook.SaveAs FileName , FileFormat:=xlExcel8
End Sub

Windows10 Excel2019 にて動作確認

Comments

[junkij]

hatena19さん
ありがとうございます。

解決しました！