求助，指导宏运行 可以定时几分钟自动执行吗？

aosiner123

求助，指导宏运行 可以定时几分钟自动执行吗？


有无案例指导一下，谢谢。我想指定一个宏   10分钟自动运行一下

xjl565135022

1. Sub test()
   
2. Application.OnTime Now + TimeValue("00:10:00"), "test"
   
3. Debug.Print (Format(Time, "h:mm:ss"))
   
4. End Sub

复制代码

每十分钟运行一次

aosiner123

麻烦问下 是这样 吗

aosiner123

Sub 查询_Click()
Application.OnTime Now + TimeValue("00:01:00"), "查询_Click()"
Debug.Print (Format(Time, "h:mm:ss"))

   
   
   
        '第三部分查询之前清空以前的数据
   
    If MsgBox("查询之前先清空原有数据") = vbOK Then
        
        Sheet1.Range("A8:M100").ClearContents
   
    End If
   
   
    '定义数据链接对象，保存连接数据库信息；请先添加ADO引用：工具－引用－MS ADO
    Dim Conn As New ADODB.Connection
    Dim RS As New ADODB.Recordset
    Dim strConn As String, StrSQL As String, strSQL1 As String, strSQL2 As String
    Dim strSQL3 As String ', strSQL4 As String, strSQL5 As String
    Dim T As Single
    Dim P1 As Range, P2 As Range, P3 As Range  ', P4 As Range, P5 As Range

   Application.StatusBar = "正在查询写入EXCEL数据，请耐心等待..."
   Set P1 = Sheet1.Range("B1")
   Set P2 = Sheet1.Range("B2")
    'Set P3 = Sheet1.Range("B3")
   'Set P4 = Sheet1.Range("B4")
   'Set P5 = Sheet1.Range("B5")
   If (P1 = "" Or P2 = "") Or (CDate(P1) > CDate(P2)) Then MsgBox "您输入的查询时间为空或" & Chr(10) & "开始时间大于结束时间": Exit Sub
   If CDate(P2) - CDate(P1) > 93 Then MsgBox "查询跨度超过93天，请重试！": Exit Sub
    T = Timer
   
    StrSQL = "SELECT * FROM BIDW_ACT_SHANGY482024"
    strSQL1 = "UPDATE SIEBEL.BI_PARAMETERXJ SET STR_VALUE = '" & P1 & "' WHERE NAME = 'BAOXIU01'"
    strSQL2 = "UPDATE SIEBEL.BI_PARAMETERXJ SET STR_VALUE = '" & P2 & "' WHERE NAME = 'BAOXIU02'"
    ' strSQL3 = "UPDATE SIEBEL.BI_PARAMETERXJ SET STR_VALUE = '" & P3 & "' WHERE NAME = 'YICIDALEI'"
   ' strSQL4 = "UPDATE SIEBEL.BI_PARAMETERXJ SET STR_VALUE = '" & P4 & "' WHERE NAME = 'CXZHUANGTAI01'"
   ' strSQL5 = "UPDATE SIEBEL.BI_PARAMETERXJ SET STR_VALUE = '" & P5 & "' WHERE NAME = 'CXFZX01'"
    strConn = "Provider=MSDAORA.1; user id=123; password=123; data source = 123; Persist Security Info=True"
      With Conn
        .Open strConn
        .Execute strSQL1
        .Execute strSQL2
       '  .Execute strSQL3
      '  .Execute strSQL4
      '  .Execute strSQL5
        Set RS = .Execute(StrSQL)
        'Rs.Open strSQL, Conn
        If RS.EOF Then
            MsgBox "没有查询到记录，程序退出"
            Set Conn = Nothing
            Set RS = Nothing
            Conn.Close
            Exit Sub
        End If
      

   
   
    Application.ScreenUpdating = False
         Sheet1.Range("A8:M100").ClearContents
         
        Sheet1.Range("A8:M8").CopyFromRecordset RS
        
    Application.ScreenUpdating = True
        RS.Close
        .Close
    End With
    Set Conn = Nothing
    Set RS = Nothing
    MsgBox ("查询完成,所用时间" & Format((Timer - T) / 60, "0.00") & "分钟")
   Application.StatusBar = ""
    Sheet1.Select
End Sub

aosiner123

我加上了，还是没有自动到时间运行

xjl565135022

1. Sub auto_run()
   
2. Application.OnTime Now + TimeValue("00:10:00"), "auto_run"
   
3. Call 查询_Click
   
4. End Sub

复制代码

加这一段就可以了

山海风云轩

xjl565135022 发表于 2024-9-15 17:17
加这一段就可以了

请问是需要放在thisworkbook里面吗？

aosiner123

发现只有鼠标动的时候，到时间去自动运行如果电脑没有操作，这个宏 不会去自动运行，有什么好的解决办法吗？

xjl565135022

山海风云轩 发表于 2024-9-16 16:21
请问是需要放在thisworkbook里面吗？

你的这段 查询_Click 代码在哪里你就加到哪里就好

山海风云轩

aosiner123 发表于 2024-9-16 17:20
发现只有鼠标动的时候，到时间去自动运行如果电脑没有操作，这个宏 不会去自动运行，有什么好的解决办法吗 ...

对，就是打开文档后，如果让他每隔10分钟自动运行一次