VBScript Excel проблема - PullRequest
       3

VBScript Excel проблема

0 голосов
/ 11 сентября 2011

Я создал скрипт vbs, который читает файл Excel в объект Dictionary.Когда я запускаю скрипт, он ничего не делает.Нет сообщения об ошибке.

Это код:

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
    msgbox word & " is not in the glossary."
end if

Ответы [ 2 ]

6 голосов
/ 11 сентября 2011

Вам не нужно добавлять intRow = intRow + 1 в цикл?

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
3 голосов
/ 11 сентября 2011

Если все, что вы хотите сделать, это найти слово в Excel, было бы гораздо быстрее использовать ADO.Вот некоторые заметки:

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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...