VBA HTML未在所有计算机上运行

时间:2014-07-24 01:13:44

标签: html excel vba internet-explorer

所以我有这个代码,我正在为我的deptarment工作,去网站输入数据,点击运行并将csv文件下载到工作表。它可以在我的电脑和其他部门使用的计算机上的配置文件中正常工作。我们都使用相同版本的windows,excel和IE。当我有来自其他部门的人运行宏时,它会打开网站,但从不将数据输入到字段中,尽管该网站与我登录时的编码完全相同。

Sub testmetric()



Dim appIE As Object
Dim Obj As Object

On Error Resume Next

Sheets("Audit").Select

Selection.AutoFilter

Sheets("Audit").Cells.Clear



Application.ScreenUpdating = False

Application.ScreenUpdating = True
Set appIE = CreateObject("InternetExplorer.Application")


sURL = "http://cctools/rportal/main.php?p=agentavaya"

' Instructes the macro to open IE and navigate to sURL.
With appIE
    .Navigate sURL
    .Visible = True

    Application.Wait Now + TimeValue("00:00:02")
     Set HTMLDOC = .Document
End With



Application.Wait Now + TimeValue("00:00:02")


appIE.Document.getElementById("agentLob").selectedIndex = "3"

appIE.Document.getElementById("timezone").selectedIndex = "1"




appIE.Document.getElementById("sdate").Value = Range("Date_Start")


   appIE.Document.getElementById("edate").Value = Range("Date_End")





   appIE.Document.getElementById("stenure").Value = Range("TenStart")

   appIE.Document.getElementById("etenure").Value = Range("TenEnd")





Application.Wait Now + TimeValue("00:00:02")

For Each Btninput In appIE.Document.getElementsByTagName("INPUT")
    If Btninput.Value = " Run " Then
        Btninput.Click
        Exit For
    End If
     Next



     Application.Wait Now + TimeValue("00:00:02")

Call CSV


appIE.Quit

Sheets("Audit").Select
Range("A1").Select
Sheets("audit").Paste



  End Sub

Sub CSV()
sCSVLink = "http://cctools/rportal/csvexport.php"
sfile = "csvexport.php"
ssheet = "Sheet10"

Set wnd = ActiveWindow

Application.ScreenUpdating = False


Workbooks.Open Filename:=sCSVLink

Windows(sfile).Activate
ActiveSheet.Cells.Copy
wnd.Activate
Range("A1").Select
Sheets("Audit").Paste
Application.DisplayAlerts = False
Windows(sfile).Close False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Sheets("Audit").Select
Range("A1").Select
Sheets("audit").Paste


End Sub

当此代码由其他部门的成员运行时,它只是打开网站输入任何内容,并且不按网站上的RUN按钮。

关于可能导致这种情况的任何想法?什么设置或任何东西。我验证了PC的VBA引用都在那里,没有" Locations缺少路径" 。

2 个答案:

答案 0 :(得分:1)

您永远不会检查网页是否已完成加载!

您的On Error Resume Next语句也隐藏了任何错误,并阻止您通过修复代码采取适当的补救措施。请用特定的错误编号和提示错误的行报告。我知道哪一行和哪个错误,我的答案是针对那个:

在线输入91错误:Set HTMLDOC = .Document

为什么?

当你等待时,Application.Wait是一种等待浏览器加载的非常无效的方法,并且2秒可能并不总是足够的时间。假设你遇到类型91错误,我能想到的最好的办法就是这样:

如何为浏览器控制创建一个准备等待循环

基本上你需要将线程放在一个循环中,直到浏览器加载了页面。在伪代码中,你正在做:

Do Until Browser Is Loaded
   DoEvents 'etc.
Loop

使用WinAPI睡眠功能

您需要使用WinAPI Sleep功能(很多人使用DoEventsApplication.Wait,但我在此处发现Sleep更可取。

因为它是Declare,你必须把它放在一个普通的模块中,它不能放在类或用户表单模块中。

'## This needs to go in an ordinary code module
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

调用WinAPI睡眠功能

Sleep 250   'sleep for 1/4 of a second, or Sleep 1000 to sleep for a full second, etc.

全部放在一起

您需要在Do ... Loop方法之后立即调用.Navigate来调用此函数。

   '## This goes in where you do Navigate method:
    With appIE
        .Navigate sURL

        Do
            Sleep 250
        Loop While Not .ReadyState <> 4 'READYSTATE_COMPLETE

        Set HTMLDoc = .Document
    End With

如果仍然无效......

是的,总有例外。我做的网络自动化很少,而我所做的大部分工作就是在这里修补一些东西来帮助人们。我注意到,越来越多的网站是动态提供的(AJAX可能是?),在这些情况下,浏览器可能是.ReadyState = READYSTATE_COMPLETE甚至是.Busy = False,但.Document仍然是{{} 1}}。

如果发生这种情况,您可以设置二级循环,例如:

Nothing

您可能希望像我在那里一样添加迭代器/计数器并模拟超时,否则这可能会进入无限循环。

答案 1 :(得分:0)

感谢所有提供大量优惠的好建议。这背后的真正错误是Windows设置。 UAC:

http://windows.microsoft.com/en-us/windows7/products/features/user-account-control 将其设置为“从不通知”的底部立即修复它。