|
エラー処理を施してみました。
※改善の余地があるかもしれませんが、とりあえず
ブック名の重複チェックのみ付け加えました。
On Error GoTo errmsg
Dim Obj As Object
Dim myDir As String
Dim S as String
Set Obj = CreateObject("Shell.Application"). _
BrowseForFolder(0, "保存したいフォルダを選択して「OK」ボタンをクリックして下さい。", 0)
If Obj Is Nothing Then Exit Sub
myDir = Obj.Items.Item.Path
UserForm1.Show
errmsg:
-------------------------------------------------------------------------
'Application.DisplayAlerts = False 'エラー処理を行っているので不要かも
s = myDir & "\" & UserForm1.TextBox1.value & ".xls"
If Dir(s) <> "" Then
MsgBox "既に存在します。ブック名を付けなおしてください。"
Exit Sub
Else
ActiveWorkbook.SaveAs myDir & "\" & UserForm1.TextBox1.Value & ".xls"
Application.DisplayAlerts = True
Application.Quit
End If
|
|