所以我被赋予了在我为网站工作的公司中创建新用户的任务。我获得了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次后才出现此错误
答案 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