【原】VBA小技巧：如何避免保存同名文件警告提示及報(bào)錯(cuò)

冷茶視界 2024-12-23 發(fā)布于江蘇

展開(kāi)全文

內(nèi)容提要

Application.DisplayAlerts
工作簿取名技巧
循環(huán)已打開(kāi)工作簿

大家好，我是冷水泡茶。

我們?cè)趯?xiě)VBA代碼的時(shí)候，經(jīng)常會(huì)碰到把結(jié)果保存為一個(gè)新的工作簿的情況，比如，我們輸入以下代碼：

Sub saveNewFile()    Dim wb As Workbook    Dim fileName As String    Set wb = Workbooks.Add    wb.Sheets(1).Cells(1, 1) = Now    fileName = "test.xlsx"    wb.SaveAs ThisWorkbook.Path & "\" & fileName    wb.Close    MsgBox "保存成功！"End Sub

這段代碼主要功能：

1、新建一個(gè)工作簿wb。

2、在wb第一個(gè)工作表中的第一個(gè)單元格寫(xiě)入當(dāng)前時(shí)間。

3、給文件名變量fileName賦值為"text.xlsx"。

3、把工作簿保存在當(dāng)前文件路徑下，文件名為fileName。

我們第一次運(yùn)行該代碼時(shí)，沒(méi)有什么問(wèn)題，在當(dāng)前文件夾下保存了一個(gè)名為test.xlsx的文件，但是，當(dāng)我們?cè)俅芜\(yùn)行時(shí)，就會(huì)出現(xiàn)一個(gè)警告提示當(dāng)前：

如果我們點(diǎn)是，則覆蓋原件文件，保存成功。

如果我們選否，則會(huì)報(bào)錯(cuò)：

是不是有點(diǎn)煩人？那么，如何解決呢？我們今天介紹三種方法：

方法1：不顯示警告

我們?cè)诖a的開(kāi)頭添加：

Application.DisplayAlerts = False

這樣就不會(huì)顯示剛才的警告信息了。不過(guò)，要記得在代碼結(jié)束前，把Fale改為T(mén)RUE：

Application.DisplayAlerts = True

不過(guò)，還有一種特殊情況，如果前面保存過(guò)的文件，現(xiàn)在處于打開(kāi)狀態(tài)，這時(shí)候，又會(huì)出現(xiàn)另一種報(bào)錯(cuò)：

在測(cè)試代碼的時(shí)候，經(jīng)常碰到，一不小心，忘了關(guān)閉已打開(kāi)的文件，就來(lái)個(gè)報(bào)錯(cuò)。

針對(duì)這種情況，我們可以再增加一段代碼，在保存文件前，先檢查一下有沒(méi)有已打開(kāi)同名文件，有則把它關(guān)閉：

Dim wbOpened As WorkbookFor Each wbOpened In Workbooks    If wbOpened.Name = fileName Then        wbOpened.Close savechanges:=False        Exit For    End IfNext

方法2：給文件名加上當(dāng)前時(shí)間

時(shí)間每秒都在變化，一般情況下不會(huì)出現(xiàn)重復(fù)，除非你能在1秒之內(nèi)保存多次。我們把給變量fileName賦值的語(yǔ)句改一下：

fileName = "test" & Format(Now, "yyyymmddhhss") & ".xlsx"

這里時(shí)間的格式要處理一下，不能直接拼接。

方法3：文件名加上隨機(jī)數(shù)

隨機(jī)數(shù)，一般也不太會(huì)產(chǎn)生重復(fù)，我們把給變量fileName賦值的語(yǔ)句改為：

 fileName = "test" & Replace(Rnd(), ".", "") & ".xlsx"

這里我們用replace函數(shù)把隨機(jī)數(shù)中的小數(shù)點(diǎn)去掉，省得跟擴(kuò)展名前的點(diǎn)混淆，當(dāng)然不去也沒(méi)有問(wèn)題，只是看上去有點(diǎn)不太順眼。

最后，為了保險(xiǎn)起見(jiàn)，我們可以再加上Application.DisplayAlerts語(yǔ)句。

完整代碼

Sub saveNewFile()    Dim wb As Workbook    Dim fileName As String
'    On Error Resume Next    Application.DisplayAlerts = False    Set wb = Workbooks.Add    wb.Sheets(1).Cells(1, 1) = Now
    fileName = "test.xlsx"    'fileName = "test" & Format(Now, "yyyymmddhhss") & ".xlsx"    'fileName = "test" & Replace(Rnd(), ".", "") & ".xlsx"    'fileName = "test" & Rnd() & ".xlsx"        Dim wbOpened As Workbook    For Each wbOpened In Workbooks        If wbOpened.Name = fileName Then            wbOpened.Close savechanges:=False            Exit For        End If    Next
    wb.SaveAs ThisWorkbook.Path & "\" & fileName    wb.Close    MsgBox "保存成功！"    Application.DisplayAlerts = TrueEnd Sub