通过计划任务打开EXCEL自动执行程序

tonyibm · 发表于 2017-3-12 20:35

我通过WINOWS的任务计划来定时打开EXCEL表，然后在工作薄打开事件中调用程序去网站上取当前在线人数，

现在有个问题，如果是计划任务自动打开的话，就取不到数，如果是我手动打开工作薄，就可以取到数，不知道为啥会这么奇怪，

lss001 · 发表于 2017-3-12 20:42

程序打开时有可能没不执行宏

tonyibm · 发表于 2017-3-12 20:47

有执行，可以看到程序自动的打开指定的网页，

lss001 · 发表于 2017-3-12 20:50

上附件看看是不是代码问题

tonyibm · 发表于 2017-3-12 20:52

注意到一个问题，我如果手动打开EXCEL的话，EXCEL的窗口是最先出现的，如果是计划任务调用的话，可以看到，是网页先打开，EXCEL窗口要过会才看到有出现，
我在想是不是这个延迟导致的取不到数，

tonyibm · 发表于 2017-3-12 20:54

lss001 发表于 2017-3-12 20:50
上附件看看是不是代码问题

如果是代码问题的话，手动也会有问题了，但是手动打开EXCEL，是一点问题也没有的，

tonyibm · 发表于 2017-3-12 21:02

workbook的打开事件，

Private Sub Workbook_Open()
If Minute(Now) Mod 5 = 0 Or Minute(Now) = 0 Then
Call test1
End If
End Sub

复制代码

模块

Sub test()
On Error Resume Next
Dim ie As Object
Dim ie1 As Object
Dim doc As Object
Dim i As Integer
Dim x As Integer
Dim iCol As Integer
Dim lhWndP As Long
Set ie1 = CreateObject("InternetExplorer.Application")
ie1.Visible = True
ie1.Navigate "http://bip.countrygarden.com.cn/sys/portal/page.jsp?pageId=159cb79eea9d3d6a8349ca840e0894d4"
Do While ie1.ReadyState <> 4 Or ie1.Busy
DoEvents
Loop
Set doc = ie1.document
If Not doc.all("j_username") Is Nothing Then
doc.all("j_username").Value = "*****"
doc.all("password").Value = "****"
For Each link In doc.getelementsbytagname("a")
If link.Text = "登录" Then
link.Click
Exit For
End If
Next
Do While ie1.ReadyState <> 4 Or ie1.Busy
DoEvents
Loop
End If
Application.Wait (Now + TimeValue("00:00:05"))
Set ie = CreateObject("InternetExplorer.Application")
ie.Visible = True
ie.Navigate "http://bip.countrygarden.com.cn/sys/portal/page.jsp?pageId=159cb79eea9d3d6a8349ca840e0894d4"
Do While ie.ReadyState <> 4 Or ie.Busy
DoEvents
Loop
Set doc = ie.document
If Not doc.all("j_username") Is Nothing Then
doc.all("j_username").Value = "*****"
doc.all("password").Value = "*****"
For Each link In doc.getelementsbytagname("a")
If link.Text = "登录" Then
link.Click
Exit For
End If
Next
Do While ie.ReadyState <> 4 Or ie.Busy
DoEvents
Loop
End If
Set doc = ie.document
For Each span In doc.getelementsbytagname("a")
If span.Text = "NC自助" Then
span.Click
Exit For
End If
Next
Do While ie.ReadyState <> 4 Or ie.Busy
DoEvents
Loop
Application.Wait (Now + TimeValue("00:00:10"))
With CreateObject("Shell.Application")
For Each oWin In .Windows
If TypeName(oWin.document) = "HTMLDocument" And oWin.LocationName Like "HR门户*" Then
For Each div In oWin.document.activeelement.document.getelementsbytagname("div")
If div.innertext Like "在线人数*" Then
num_online = Split(Split(div.innertext, "('")(1), "')")(0)
oWin.Quit
End If
Next
End If
Next
End With
ie1.Quit
ie.Quit
Set ie1 = Nothing
Set ie = Nothing
End Sub
Sub test1()
On Error Resume Next
Dim today_date As Date
Dim today_time As Date
Dim rng_date As Range
Dim rng_time As Range
Dim Ret As Long
Dim WINWND As Long
Const TimeOut As Long = 10000
If Hour(Now) = 0 And Minute(Now) = 0 Then
today_date = DateValue(Year(Now) & "/" & Month(Now) & "/" & Day(Now) - 1)
Else
today_date = DateValue(Year(Now) & "/" & Month(Now) & "/" & Day(Now))
End If
today_time = TimeValue(Hour(Now) & ":" & Minute(Now) & ":00")
Set rng_date = Sheets("SSC在线用户记录").Rows(1).Find(what:=today_date)
Set rng_time = Sheets("SSC在线用户记录").Columns(1).Find(what:=today_time)
If Not rng_date Is Nothing And Not rng_time Is Nothing Then
Call test
Sheets("SSC在线用户记录").Cells(rng_time.Row, rng_date.Column) = num_online
MsgBoxEx 0, Sheets("SSC在线用户记录").Cells(rng_time.Row, rng_date.Column).Value, TimeOut / 1000 & "秒后自动关闭", vbOK + vbInformation, 1, TimeOut
Call IeClose
End If
ThisWorkbook.Save
Application.Quit
End Sub

复制代码

Sub IeClose()
For Each Process In GetObject("winmgmts:").ExecQuery("select * from Win32_Process where name='iexplore.exe'")
Process.Terminate (0)
Next
End Sub

复制代码

lss001 · 发表于 2017-3-12 21:02

tonyibm 发表于 2017-3-12 20:52
注意到一个问题，我如果手动打开EXCEL的话，EXCEL的窗口是最先出现的，如果是计划任务调用的话，可以看到， ...

那么有可能是跟excel与IE启动先后有关，原则上应先启动excel再执行宏，用宏代码打开IE

yayahzmeng · 发表于 2017-3-12 22:08

让EXcel先数5000个羊羊后再call

tonyibm · 发表于 2017-3-12 22:33

没有用，我用了wait还是不行，

		自动登录	找回密码
密码			免费注册

[求助] 通过计划任务打开EXCEL自动执行程序

最新热点 /1