Sub SaveSheet()
'以下程式碼試用 Excel 200~2010版
Dim wks As Worksheet
    Set wks = ActiveSheet
    With wks
        If Val(Application.Version) < 12 Then
            'Excel 版本 97-2003
            'xlWorkbookNormal -4143 一般活頁簿
            FileExtStr = ".xls": FileFormatNum = -4143
        Else
            Select Case .Parent.FileFormat
                'xlOpenXMLWorkbook 51 開啟 XML 活頁簿
            Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
            Case 52:
                If .Parent.HasVBProject Then
                    'xlOpenXMLWorkbookMacroEnabled 52 開啟 XML 活頁簿巨集啟用
                    FileExtStr = ".xlsm": FileFormatNum = 52
                Else
                    FileExtStr = ".xlsx": FileFormatNum = 51
                End If
            End Select
        End If
        .Copy
        Application.DisplayAlerts = False
        ActiveWorkbook.SaveAs .Parent.Path & "\" & .Name & FileExtStr, FileFormatNum
        Application.DisplayAlerts = True
        ActiveWorkbook.Close SaveChanges:=False
    End With
End Sub

無

Option Explicit
Dim WLshtApp As New xlsClass   '引用到class
　

Sub close_othert_xls()
    Dim wbk As Workbook
    For Each wbk In Application.Workbooks
        If wbk.Name <> ThisWorkbook.Name Then
            MsgBox "程式執行階段，其他檔案將先行關閉"
            wbk.Close
        End If
    Next wbk
End Sub

Option Explicit
Dim ExcelApp As Application
Public WithEvents xlsEvents As Application
　

  還有幾個類似的範例請參考

     讓檔案以獨佔的方式開啟

Option Explicit
　

'Option Explicit
Private Declare Function URLDownloadToFile Lib "urlmon" Alias _
        "URLDownloadToFileA" (ByVal pCaller As Long, _
        ByVal szURL As String, ByVal szFileName As String, _
        ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
　

Sub FindHtm(sURL As String)
    Dim IE As New InternetExplorer
    Dim oDoc As New MSHTML.HTMLDocument
    Dim i As Integer
    IE.navigate sURL
    Do While IE.ReadyState <> READYSTATE_COMPLETE
        UrlForm.Label1.Caption = "網頁下載中請稍候......"
        DoEvents
    Loop
    UrlForm.Label1.Caption = ""
    '引用 Document 對象
    Set oDoc = IE.Document
    '獲取以順序排列的HTML 標籤中所有 Links 對象的集合。
    For i = 0 To oDoc.Links.Length
        On Error Resume Next
        If Right(oDoc.Links(i).href, 3) = "htm" Or _
                Right(oDoc.Links(i).href, 4) = "html" Then
            'href:獲取目標URL(完整網址)
            UrlForm.ListBox1.AddItem oDoc.Links(i).href
        End If
    Next i
    Set oDoc = Nothing
    Set IE = Nothing
End Sub
　

---

'下載檔案
Sub saveHtm(sURL As String, sPath As String)
    f = GetFileName(sURL)
    '將網際網路上的下載資料儲存至檔案
    returnValue = URLDownloadToFile(0, sURL, sPath & f, 0, 0)
    UrlForm.Label1.Caption = "網頁下載完成"
End Sub
　

---

'取檔名
Function GetFileName(sText As String) As String
    Dim pos As Integer
    Do
        GetFileName = Mid(sText, pos + 1)
        pos = InStr(pos + 1, sText, "/")
    Loop While pos > 0
End Function
　

---

Sub FormShow()
    UrlForm.Show 0
End Sub

Option Explicit
Dim r As Integer, i As Integer