vba当其他用户使用File时打开excel

时间:2014-09-18 12:51:35

标签: excel-vba vba excel

这是我目前的代码

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

我要打开的文件是一个共享文件。如果没有使用,或者我已经打开文件,这段代码工作正常。但是,每当其他用户打开文件时,此代码就会停止。

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

Error Screenshot

很抱歉,如果这是一个愚蠢的问题,但我完全不熟悉编码。

3 个答案:

答案 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