VBScript Excel problem
I have made a vbs script that reads an Excel file into a Dictionary object. When I run the script it does not do anything. There is no error message.
This is the code:
Set objWords = CreateObject("Scripting.Dictionary")
objWords.CompareMode = 1
CurPath = CreateObject("Scripting.FileSystemObject").GetAbsolutePathName(".")
Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open(CurPath & "/RE Glossary.xls")
Set objWorksheet = objExcel.ActiveWorkBook.WorkSheets("MG")
intRow = 1
Do Until (objExcel.Cells(intRow, 1).Value) = ""
Value1 = (objExcel.Cells(intRow, 1).Value)
Value2 = (objExcel.Cells(intRow, 2).Value)
objWords.item(Value1) = Value2
Loop
objExcel.Quit
msgbox "There are " & objWords.Count & " words in the glossary."
word = inputbox("word")
if objWords.exists(word) then
msgbox word & vbnewline & "------------" & vbnewline & objWords.item(word)
else
ms开发者_如何学Cgbox word & " is not in the glossary."
end if
Don't you need to add intRow = intRow + 1
into loop?
intRow = 1
Do Until (objExcel.Cells(intRow, 1).Value) = ""
Value1 = objExcel.Cells(intRow, 1).Value
Value2 = objExcel.Cells(intRow, 2).Value
objWords.item(Value1) = Value2
intRow = intRow + 1
Loop
If all you want to do is to look up a word in Excel, it would be much quicker to use ADO. Here are some notes:
Dim cn, rs
Dim strFile, strCon, strSQL, Word
CurPath = CreateObject("Scripting.FileSystemObject").GetAbsolutePathName(".")
strFile = "/RE Glossary.xls"
''Note that if HDR=No, F1,F2 etc are used for column names,
''if HDR=Yes, the names in the first row of the range
''can be used.
''This is the Jet 4 connection string, you can get more
''here : http://www.connectionstrings.com/excel
strCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & CurPath & strFile _
& ";Extended Properties=""Excel 8.0;HDR=No;IMEX=1"";"
''Late binding, so no reference is needed
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
cn.Open strCon
Word = InputBox("Word")
If Word <> vbNullString Then
strSQL = "SELECT Count(F1) As WordCount " _
& "FROM [Sheet2$] AS a " _
rs.Open strSQL, cn, 3, 3
strMessage = "There are " & rs.Fields("WordCount") & " words in the glossary."
rs.Close
strSQL = "SELECT F1 " _
& "FROM [Sheet2$] a " _
& "WHERE F1 = '" & Word & "'"
rs.Open strSQL, cn, 3, 3
If rs.RecordCount > 0 Then
strMessage = strMessage & vbNewLine & word & vbNewLine & "------------" & vbNewLine & rs.Fields("F1")
Else
strMessage = strMessage & vbNewLine & word & " is not in the glossary."
End If
''Tidy up
rs.Close
Set rs=Nothing
cn.Close
Set cn=Nothing
Else
strMessage = "Nothing selected."
End If
MsgBox strMessage
精彩评论