一段换汤不换药的代码－Excel和数据库中数据匹配并根据条件刷新数据相关数据的代码

Sub Click(Source As Button)
    On Error Goto sl
'-------------------------------------------------------------
'-- Created by Jacky Shu on 2008-04-23
'-- For upload GRD Codes through the MFG Codes matching
'-------------------------------------------------------------
    Dim ws As New NotesUIWorkspace        'workspace
    Dim ss As New NotesSession            'session
    Dim db As NotesDatabase                'database
    Dim item As NotesItem                'notes item
    Dim files As Variant                'file name
    Dim schar As String                    'cell content    
    Dim doc As NotesDocument                'notes document
    Dim dc As NotesDocumentCollection        'notes documents collection
    Dim excelapplication                'Excel
    Dim i,j As Integer                    'number counter
    Dim rowcount As Integer                'rows that need operate
    Dim temp As String
    Set db = ss.currentdatabase
    Set dc=db.UnprocessedDocuments
    rowcount=dc.Count
    Messagebox("您选中了" + Cstr(rowcount) + "条记录，请您准备好文件，本次操作仅导入文件中的前" + Cstr(rowcount) + "条记录。" + Chr(13)+Chr(10)+"如果文件内数据行数不足，将以空值或0添入数据库。")
    files = ws.openfiledialog(False,"请选择要导入的Excel文件","Excel file/*.xls")
    Set excelapplication = createobject("excel.application")
    Set excelworkbook = excelapplication.workbooks.open(files)
    Set excelsheet = excelworkbook.worksheets(1)
    
    Set doc = dc.GetFirstDocument
    While Not (doc Is Nothing)
        
        temp = doc.SpecNumber(0)
        For x = 1 To 281
            If temp = excelsheet.cells(x,2).value Then
                doc.SpecNumber_new = excelsheet.cells(x,1).value
                Call doc.Save(False,False)
'                Msgbox "Success",64,"excel line at : "&Cstr(x)
            End If
        Next
        
        Set doc=dc.GetNextDocument(doc)
    Wend
sl:
    Msgbox "Error Message is: " & Error & Chr(13) & "Error Line is : " & Erl
End Sub