等待其他用户关闭Excel文件

bzzcjhmw  于 2023-01-18  发布在  其他
关注(0)|答案(1)|浏览(134)

我创建了一个“登录跟踪”系统,100个人都使用保存在电脑上的excel表格,当他们点击“提交”时,它会打开另一个.xlsb文件(RTS报告),找到下一行,并将数据放到下一行。这一切需要2-5秒完成,但是,如果两个人同时点击“提交”,那么其中一个人会得到文件已经打开的错误。
im新的vba请帮助我为以下场景编码
1.检查数据库.xlsb是否被其他用户打开
1.如果没有,请继续执行代码
1.如果是(文件不可用),代码需要等待直到文件关闭

Sub RTS()

ThisWorkbook.Activate
Application.DisplayAlerts = False

ActiveSheet.Range("A7:D7", "Q7").Select
Range("Q7").Activate
Application.CutCopyMode = False
Selection.Copy

Application.ScreenUpdating = False

Workbooks.Open Filename:="RTS Report.xlsx", ReadOnly:=False
Dim she As Worksheet

Dim a As Integer
ActiveWorkbook.Sheets("data").Activate
Set she = actveworkbook.actvesheet

b = she.Range("A" & Rows.Count).End(xlUp).Row

she.Range("A" & b + 1).PasteSpecial Paste:=xlPasteFormulasAndNumberFormats, operation:=xlNone, Skipblanks:=False, Transpose:=False

Cells.Select
Cells.EntireColumn.AutoFit

ActiveWorkbook.Save
Application.ScreenUpdating = True

ThisWorkbook.Activate

End Sub
ne5o7dgx

ne5o7dgx1#

正如评论中提到的,excel在这方面并不理想,但如果是你唯一拥有的东西,下面的应该会起作用。
尝试到打开直到错误消失

Sub RTS()

ThisWorkbook.Activate
Application.DisplayAlerts = False

ActiveSheet.Range("A7:D7", "Q7").Select
Range("Q7").Activate
Application.CutCopyMode = False
Selection.Copy

Application.ScreenUpdating = False
cont = True

On Error Resume Next
While cont
    Err.Clear
    Workbooks.Open Filename:="RTS Report.xlsx", ReadOnly:=False
    If Err.Number <> 0 Then
        Application.Wait (Now + TimeValue("0:00:01"))
        Err.Clear
    Else
        cont = False
    End If
Wend
On Error GoTo 0

Dim she As Worksheet

Dim a As Integer
ActiveWorkbook.Sheets("data").Activate
Set she = actveworkbook.actvesheet

b = she.Range("A" & Rows.Count).End(xlUp).Row

she.Range("A" & b + 1).PasteSpecial Paste:=xlPasteFormulasAndNumberFormats, operation:=xlNone, Skipblanks:=False, Transpose:=False

Cells.Select
Cells.EntireColumn.AutoFit

ActiveWorkbook.Save
Application.ScreenUpdating = True

ThisWorkbook.Activate

End Sub

相关问题