vba 当另一个用户使用文件时，vba打开excel

vba Open excel when File is used by another user

提问by Harunojikan

This is my current code

这是我当前的代码

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

The file I am trying to open is a shared file. When no is it using, or when I already opened the file, this code works fine. But whenever another user already open a file, this code stops.

我试图打开的文件是一个共享文件。当没有使用时，或者当我已经打开文件时，此代码工作正常。但是只要另一个用户已经打开了一个文件，这个代码就会停止。

I know for a fact that even if another use is using the file, I can still open it in Read-Only mode. So my question is how to include that code in here, and hopefully without the pop-up asking if you want to open in Read-Only mode.

我知道即使另一个用户正在使用该文件，我仍然可以以只读模式打开它。所以我的问题是如何在此处包含该代码，希望没有弹出窗口询问您是否要以只读模式打开。

Sorry if this is a dumb question, but I am totally new to coding.

对不起，如果这是一个愚蠢的问题，但我对编码完全陌生。

回答by Harunojikan

First of all thanks for you input. I have solve the problem on my own with some trial and error.

首先感谢您的输入。我已经通过一些试验和错误自己解决了这个问题。

changed the code to the following

将代码更改为以下内容

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"

changed everything in this else statement

改变了这个 else 语句中的所有内容

    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

回答by Travis Dawson

I had the same issue and was helped somewhat by the existing posts, here. However, there was still a gap between the recommendations and reality. So, I'll try to share my lessons learned.

我遇到了同样的问题，这里的现有帖子对我有所帮助。然而，建议与现实之间仍有差距。所以，我会尽量分享我的经验教训。

In my case, I needed Workbooks.Open to open the most recent file in a shared folder. This file is often referenced by other users and is therefore frequently open by other users. Below is my first pass to give the VBA code "permission" to open the file as "read only."

就我而言，我需要 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

This actually works EXCEPT for when excel creates a temporary file in the source folder (the temp file will, therefore, always be the newest file in the folder). To handle that exception, I needed to truncate the temp characters: "~$". I have done that with

这实际上适用于当 excel 在源文件夹中创建临时文件时（因此，临时文件将始终是文件夹中的最新文件）。为了处理该异常，我需要截断临时字符：“~$”。我已经这样做了

Right([your_string], integer_length_of_string)

See in context below.

请参阅下面的上下文。

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

回答by Mike Powell

I would replace all the scripted above with this:

我会用这个替换上面所有的脚本：

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