Question

我想知道是否有办法通过vba远程停用excel文件。

问题：
我公司使用excel文件进行销售，为客户提供报价。现在，当我们的定价方案有更新时，我会将新版本的Excel文件发送给销售团队。接下来发生的显而易见的事情是他们不使用文件的最新版本来给出引用=＆gt;客户的价格错误。

到目前为止我尝试了什么：
我实现了一个定时炸弹，让文件在定义的日期到期。这样做的问题是对excel文件的更新不定期发生。

我的想法：
excel文件启动后，VBA脚本会向Web服务器查询最新版本号。如果当前打开的Excel文件中的版本号低于服务器提供的版本号，则该文件将锁定。

这是用Excel和VBA实现的吗？我可以想象这会导致Windows安全等问题，因为它可能看起来像木马或病毒。

非常感谢您的帮助！

Answer 1

如果您向他们发送.xlsm文件，则以下代码（由Tom Drtis提供，来自“ VBA和Macros for Microsoft Excel” ）将删除该文件，所选日期已过。请小心使用此代码，并始终确保已保存备份副本。

将此子句粘贴到vba的“工作簿”部分，并且每次打开文件时都会执行该子部分。如果当前日期在所选日期之后，它将删除该文件。

Private Sub workbook_open()

    If Date > CDate("13.07.16") Then

       With ThisWorkbook

           .Saved = True
           .ChangeFileAccess xlReadOnly
           Kill .FullName
           .Close False
      End With

    End If

End Sub

Answer 2

你也可以通过文件版本检查而不是按日期，参考可用版本的单元格。

Private Sub workbook_open()

    If [A1].value > "v.02.15" Then

       With ThisWorkbook

           .Saved = True
           .ChangeFileAccess xlReadOnly
           Kill .FullName
           .Close False
      End With

    End If

End Sub

Answer 3

Sub ПримерИспользования()
    Dim ra As Range: On Error Resume Next

    Set ra = GetQueryRange("http://ExcelVBA.ru/", 6)
    Debug.Print ra '.Address    ' переменная ra содержит ссылку на диапазон ячеек $A$1:$C$15,
    ' содержащий данные 6-й таблицы главной страницы сайта ExcelVBA.ru

End Sub

Function GetQueryRange(ByVal SearchLink$, Optional ByVal Tables$) As Range
    On Error Resume Next: Err.Clear
    Dim tmpSheet As Worksheet: Set tmpSheet = ThisWorkbook.Worksheets("tmpWQ")
    If tmpSheet Is Nothing Then
        Application.ScreenUpdating = False
        Set tmpSheet = ThisWorkbook.Worksheets.Add
        tmpSheet.Name = "tmpWQ"
        tmpSheet.Visible = xlSheetVeryHidden
    End If
    If tmpSheet Is Nothing Then
        msg$ = "Не удалось добавить скрытый лист «tmpWQ» в файл программы"
        MsgBox msg, vbCritical, "Невозможно выполнить запрос к сайту": End
    End If

    tmpSheet.Cells.Delete: DoEvents: Err.Clear
    With tmpSheet.QueryTables.Add("URL;" & SearchLink$, tmpSheet.Range("A1"))
        If Len(Tables$) Then
            .WebSelectionType = xlSpecifiedTables
            .WebTables = Tables$
        Else
            .WebSelectionType = xlEntirePage
        End If
        .FillAdjacentFormulas = False: .PreserveFormatting = True
        .RefreshOnFileOpen = False: DoEvents
        .WebFormatting = xlWebFormattingAll
        .Refresh BackgroundQuery:=False: DoEvents
        If Err = 0 Then Set GetQueryRange = tmpSheet.UsedRange
        .Delete: DoEvents
    End With
End Function

更改第3行中的引用。将窗口Locals Window转为View \ Locals Window的路径。在开始行Toggle Breakpoint (F9)中的宏集Debug.Print ra '.Address' ra variable contains a reference to a cell range $ A $ 1: $ C $ 15,之前运行宏，然后在Locals Window窗口中选择ra \ Value2 - 它将是网站上的数据。

现在，来自该网站的数据将存储在变量ra中，并将它们与以下内容类似，以将该行更改为：

Debug.Print ra.Value2(2, 2) 'result: "У вас есть интернет-магазин?"

此代码是从网站复制的：http://excelvba.ru/code/WebQueryRange

通过vba

3 个答案: