Dim i As Integer
Dim SavePath As String
On Error GoTo B
SavePath = Dir(sfilePath & "\*.xls")
isSave = True
Do While SavePath <> ""
If UCase(SavePath) = UCase(sfileName & ".xls") Then
i = MsgBox("已經存在一個名為" & sfileName & ".xls 的文件,是否覆蓋?", vbQuestion + vbYesNo + vbDefaultButton2)
If i = vbNo Then
isSave = False
Else
isSave = True
Kill sFilePath & "\" & sFileName & ".xls"
Exit Do
End If
End If
SavePath = Dir
Loop
Exit Sub
B:
If Err = 75 Then
MsgBox sFilePath & "\" & sFileName & ".xls 已經打開,Excel表不能保存", vbCritical
isSave = False
End If
Public Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long
Public Declare Function SetFileAttributes Lib "kernel32" Alias "SetFileAttributesA" (ByVal lpFileName As String, ByVal dwFileAttributes As Long) As Long
Public Const FILE_ATTRIBUTE_READONLY = &H1
Public Const FILE_ATTRIBUTE_HIDDEN = &H2
Public Const FILE_ATTRIBUTE_SYSTEM = &H4
Enum wAtt
ReadOnly = 1
Hidden = 2
Readonly_Hidden = 3
System = 4
Hidden_System = 6
R_H_S = 7
All = 39
End Enum
Public Function File_AttRead(ByVal PathName As String, ByVal OutAtt As wAtt) As Boolean
On Error Resume Next
If GetFileAttributes(PathName) = -1 Then
File_AttRead = False'没有文件
Else
OutAtt = GetFileAttributes(PathName)
End If
End Function
Public Function File_AttWirte(ByVal PathName As String, ByVal inAtt As wAtt) As Boolean
On Error Resume Next
If GetFileAttributes(PathName) = -1 Then
File_AttWirte = False
Else
SetFileAttributes PathName, inAtt
End If
End Function
'wAtt:
' 1=Readonly
' 2=Hidden
' 3=Readonly & Hidden
' 4=System
' 6=Hidden &System
' 7=Readonly & Hidden & System
' 32=Archive
' 39=All
Function findfile(dirpath As String, filename As String) As Boolean
findfile = True
dirpath = IIf(Right(dirpath, 1) = "\", dirpath, dirpath & "\")
If Dir(dirpath & filename) = "" Then findfile = False
End Function