使用VBA填写Web表单

时间:2016-06-02 16:59:54

标签: vba

所以我被赋予了在我为网站工作的公司中创建新用户的任务。我获得了100多个用户名和电子邮件地址的excel表。我不想手动执行它所以决定尝试编写程序。我以前从未接触过VB,这是我能够达到的目标。它适用于第一次运行while循环,但后来收到错误:

  

运行时错误'91'   对象变量或未设置块变量

当我尝试调试此错误时,我的代码中的这一行会突出显示:

   IE.document.GetElementsbyname("user_login")(0).Value = ThisWorkbook.Sheets("sheet1").Cells(j, i) ' sets login info

在我的Excel电子表格中,电子邮件地址与登录信息相同,它们是通过outlook发送电子邮件的链接。我会看看这是否会导致我的错误,但与此同时,我希望得到第二双眼睛。谢谢您阅读此篇。这是我在这里发表的第一篇文章,所以如果不像你想要的那样提供信息,我会道歉

到目前为止,这是我的其余代码

Sub FillInternetForm()
Dim IE As Object
  Set IE = CreateObject("InternetExplorer.Application")
'create new instance of IE
Dim i As Integer
 Dim j As Integer
 Dim x As Integer
 Dim y As Integer
 Dim s As String
 s = "paswd" ' pasword setting
 i = 4  ' column  D for email input
      j = 50 ' row to start
    x = 9 ' column I    For last name input
    y = 10 'column j for  last name
'you want to use open IE window. Easiest way I know of is via title bar.
While j < 121

Wait
        IE.Navigate "website link"
                'go to web page listed inside quotes
    IE.Visible = True
        While IE.busy
            DoEvents  'wait until IE is done loading page.
            Wend

        IE.document.GetElementsbyname("user_login")(0).Value = ThisWorkbook.Sheets("sheet1").Cells(j, i) ' sets login info
        IE.document.GetElementsbyname("email")(0).Value = ThisWorkbook.Sheets("sheet1").Cells(j, i) '  sets email address
        IE.document.GetElementsbyname("first_name")(0).Value = ThisWorkbook.Sheets("sheet1").Cells(j, y) ' sets first name
        IE.document.GetElementsbyname("last_name")(0).Value = ThisWorkbook.Sheets("sheet1").Cells(j, x) ' sets last name
        Set elementcol = IE.document.getElementsByClassName("button button-secondary wp-generate-pw hide-if-no-js")
             elementcol.Item(0).Click 'shows the password
                While IE.busy
                     DoEvents  'wait until IE is done loading page.
                Wend
          IE.document.GetElementsbyname("pass1-text")(0).Value = s 'sets the password
         Wait 
        Set elementcol = IE.document.getElementsByClassName("pw-checkbox")
            elementcol.Item(0).Click ' clicks confirmation of weak password choice
                While IE.busy
                    DoEvents  'wait until IE is done loading page.
                Wend
        Set elementcol = IE.document.GetElementsbyname("send_user_notification")
            elementcol.Item(0).Click ' unclicks send new user email
                 While IE.busy
                    DoEvents  'wait until IE is done loading page.
                Wend
       IE.document.getElementByID("createusersub").Click ' clicks add new user

                While IE.busy
                     DoEvents  'wait until IE is done loading page.
                Wend
        j = j + 1
         While IE.busy
                     DoEvents  'wait until IE is done loading page.
                Wend


Wend
End Sub
Sub Wait()
    Application.Wait Time + TimeSerial(0, 0, 5)
End Sub

编辑:只有在我的循环中运行5次后才出现此错误

1 个答案:

答案 0 :(得分:0)

缓存可能已从所有循环中阻塞。

Option Explicit

Private Declare Function FindFirstUrlCacheGroup Lib "wininet.dll" ( _
    ByVal dwFlags As Long, _
    ByVal dwFilter As Long, _
    ByRef lpSearchCondition As Long, _
    ByVal dwSearchCondition As Long, _
    ByRef lpGroupId As Date, _
    ByRef lpReserved As Long) As Long

Private Declare Function FindNextUrlCacheGroup Lib "wininet.dll" ( _
    ByVal hFind As Long, _
    ByRef lpGroupId As Date, _
    ByRef lpReserved As Long) As Long

Private Declare Function DeleteUrlCacheGroup Lib "wininet.dll" ( _
    ByVal sGroupID As Date, _
    ByVal dwFlags As Long, _
    ByRef lpReserved As Long) As Long

Private Declare Function FindFirstUrlCacheEntry Lib "wininet.dll" Alias "FindFirstUrlCacheEntryA" ( _
    ByVal lpszUrlSearchPattern As String, _
    ByRef lpFirstCacheEntryInfo As INTERNET_CACHE_ENTRY_INFO, _
    ByRef lpdwFirstCacheEntryInfoBufferSize As Long) As Long

Private Type INTERNET_CACHE_ENTRY_INFO
    dwStructSize As Long
    szRestOfData(1024) As Long
End Type

Private Declare Function DeleteUrlCacheEntry Lib "wininet.dll" Alias "DeleteUrlCacheEntryA" ( _
    ByVal lpszUrlName As Long) As Long

Private Declare Function FindNextUrlCacheEntry Lib "wininet.dll" Alias "FindNextUrlCacheEntryA" ( _
    ByVal hEnumHandle As Long, _
    ByRef lpNextCacheEntryInfo As INTERNET_CACHE_ENTRY_INFO, _
    ByRef lpdwNextCacheEntryInfoBufferSize As Long) As Long

Private Const CACHGROUP_SEARCH_ALL = &H0
Private Const ERROR_NO_MORE_FILES = 18
Private Const ERROR_NO_MORE_ITEMS = 259
Private Const CACHEGROUP_FLAG_FLUSHURL_ONDELETE = &H2
Private Const BUFFERSIZE = 2048

Private Sub Command1_Click()
    Dim sGroupID As Date
    Dim hGroup As Long
    Dim hFile As Long
    Dim sEntryInfo As INTERNET_CACHE_ENTRY_INFO
    Dim iSize As Long

    On Error Resume Next

    ' Delete the groups
    hGroup = FindFirstUrlCacheGroup(0, 0, 0, 0, sGroupID, 0)

    ' To avoid error using it with IE4 as FindFirstUrlCacheGroup is not implemented
    If Err.Number <> 453 Then
        If (hGroup = 0) And (Err.LastDllError <> 2) Then
            MsgBox "An error occurred enumerating the cache groups" & Err.LastDllError
            Exit Sub
        End If
    Else
        Err.Clear
    End If

    If (hGroup <> 0) Then
        'we succeeded in finding the first cache group.. enumerate and
        'delete
        Do
            If (0 = DeleteUrlCacheGroup(sGroupID, CACHEGROUP_FLAG_FLUSHURL_ONDELETE, 0)) Then

               ' To avoid error using it with IE4 as FindFirstUrlCacheGroup is not implemented
               If Err.Number <> 453 Then
                 MsgBox "Error deleting cache group " & Err.LastDllError
                 Exit Sub
               Else
                  Err.Clear
               End If
            End If
            iSize = BUFFERSIZE
            If (0 = FindNextUrlCacheGroup(hGroup, sGroupID, iSize)) And (Err.LastDllError <> 2) Then
                MsgBox "Error finding next url cache group! - " & Err.LastDllError
            End If
        Loop Until Err.LastDllError = 2
    End If

  ' Delete the files
    sEntryInfo.dwStructSize = 80
    iSize = BUFFERSIZE
    hFile = FindFirstUrlCacheEntry(0, sEntryInfo, iSize)
    If (hFile = 0) Then
        If (Err.LastDllError = ERROR_NO_MORE_ITEMS) Then
            GoTo done
        End If
        MsgBox "ERROR: FindFirstUrlCacheEntry - " & Err.LastDllError
        Exit Sub
    End If
    Do
        If (0 = DeleteUrlCacheEntry(sEntryInfo.szRestOfData(0))) _
            And (Err.LastDllError <> 2) Then
            Err.Clear
        End If
        iSize = BUFFERSIZE
        If (0 = FindNextUrlCacheEntry(hFile, sEntryInfo, iSize)) And (Err.LastDllError <> ERROR_NO_MORE_ITEMS) Then
            MsgBox "Error:  Unable to find the next cache entry - " & Err.LastDllError
            Exit Sub
        End If
    Loop Until Err.LastDllError = ERROR_NO_MORE_ITEMS
done:
    MsgBox "cache cleared"
    Command1.Enabled = True
End Sub

http://www.vbforums.com/showthread.php?440508-Clear-IE-Browser-Cache-and-History-with-VBA