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

本文链接：https://blog.youkuaiyun.com/shulia/article/details/2342187

本文介绍了一种使用VBA宏将Excel数据批量导入Lotus Notes数据库的方法。该过程涉及打开Excel文件，读取特定单元格的数据，并将其更新到Notes数据库中的相应文档。通过循环遍历指定范围内的Excel单元格，确保数据正确匹配。

摘要生成于 C知道，由 DeepSeek-R1 满血版支持，前往体验 >

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