这是我目前的代码
Public Sub OpenFiles()
'Set LiveDealSheet file path
'Check if LiveDealSheet is already open
LDSP = "C:\Users\DCHEUNG\Desktop\Programing\LiveDealSheet.xlsm"
IsOTF = IsWorkBookOpen(LDSP)
'Set quick workbook shortcut
Set TWB = ThisWorkbook
If IsOTF = False Then
Set LDS = Workbooks.Open(LDSP)
Else
Workbooks("LiveDealSheet.xlsm").Activate
Set LDS = ActiveWorkbook
End If
End Sub
Function IsWorkBookOpen(FileName As String)
Dim ff As Long, ErrNo As Long
On Error Resume Next
ff = FreeFile()
'i was just browsing through the online library and I found that "Open FileName For..."
'have a lot of keywords. If I only want to open the file and copy stuff out to
'another workbook do I use "Open FileName for Input Read As #ff"?
'Then when I actually open the file in OpenFiles() I change
'"Set LDS = Workbooks.Open(LDSP)" to "Set LDS = Workbooks.Open(LDSP) (ReadOnly)"
Open FileName For Input Lock Read As #ff
Close ff
ErrNo = Err
On Error GoTo 0
Select Case ErrNo
Case 0: IsWorkBookOpen = False
Case 70: IsWorkBookOpen = True
Case Else: Error ErrNo
End Select
End Function
我要打开的文件是一个共享文件。如果没有使用,或者我已经打开文件,这段代码工作正常。但是,每当其他用户打开文件时,此代码就会停止。
我知道即使另一个用户正在使用该文件,我仍然可以在只读模式下打开它。所以我的问题是如何在这里包含该代码,并希望没有弹出询问您是否要以只读模式打开。
很抱歉,如果这是一个愚蠢的问题,但我完全不熟悉编码。
答案 0 :(得分:2)
首先感谢您的投入。我通过一些反复试验来解决这个问题。
将代码更改为以下
Public Sub OpenFiles()
'Set LiveDealSheet file path
'Check if LiveDealSheet is already open
LDSP = "Z:\LiveDealSheet.xlsm"
IsOTF = IsWorkBookOpen(LDSP)
'Set quick workbook shortcut
Set TWB = ThisWorkbook
If IsOTF = False Then
Set LDS = Workbooks.Open(LDSP)
Debug.Print "Stage 1 Success"
更改了此声明中的所有内容
Else
On Error Resume Next
Set LDS = Workbooks("LiveDealSheet.xlsm")
If LDS Is Nothing Then Workbooks.Open FileName:=LDSP, ReadOnly:=True, IgnoreReadOnlyRecommended:=True
End If
End Sub
Function IsWorkBookOpen(FileName As String)
Dim ff As Long, ErrNo As Long
On Error Resume Next
ff = FreeFile()
Open FileName For Input Lock Read As #ff
Close ff
ErrNo = Err
On Error GoTo 0
Select Case ErrNo
Case 0: IsWorkBookOpen = False
Case 70: IsWorkBookOpen = True
Case Else: Error ErrNo
End Select
End Function
答案 1 :(得分:0)
我会用以下内容替换上面的所有脚本:
Public Sub OpenFiles()
On Error GoTo not_open
Workbooks("C:\Users\DCHEUNG\Desktop\Programing\LiveDealSheet.xlsm").Activate
Exit Sub
not_open:
Workbooks.Open FileName:="C:\Users\DCHEUNG\Desktop\Programing\LiveDealSheet.xlsm", ReadOnly:=True
Err.Clear
Resume Next
End Sub
答案 2 :(得分:0)
我遇到了同样的问题,现在的帖子在这里有所帮助。但是,建议和现实之间仍然存在差距。所以,我会尝试分享我的经验教训。
就我而言,我需要Workbooks.Open来打开共享文件夹中的最新文件。此文件通常由其他用户引用,因此经常被其他用户打开。下面是我的第一个传递给VBA代码“权限”打开文件为“只读”。
' OPEN SOURCE-FILE IN READ-ONLY MODE (argument key below)
Workbooks.Open _
Filename:=strFilename, _
UpdateLinks:=0, _
ReadOnly:=True, _
IgnoreReadOnlyRecommended:=True, _
Notify:=True
当excel在源文件夹中创建临时文件时,这实际上是有效的(因此,临时文件将始终是文件夹中的最新文件)。要处理该异常,我需要截断临时字符:“〜$”。我用
完成了Right([your_string], integer_length_of_string)
参见下文。
For Each objFile In myFolder.Files
If InStr(1, objFile.Name, ".xlsm") And objFile.DateLastModified > dateFile Then
dateFile = objFile.DateLastModified
windowName = objFile.Name
If InStr(1, windowName, "~$") Then
fileNameLen = Len(objFile.Name) - 2
windowName = Right(objFile.Name, fileNameLen)
strFilename = myDir & "\" & windowName
End If
strFilename = myDir & "\" & windowName
End If
Next objFile