| Sub Click(Source As Button) |
| |
| 'The action button is located on a view |
| Dim ws As New NotesUIWorkspace |
| Dim session As New NotesSession |
| Dim db As NotesDatabase |
| Set db = session.CurrentDatabase |
| Dim view As NotesView |
| Dim doc As NotesDocument |
| Dim temp1 As String |
| Dim temp2 As String |
| Dim temp3 As String |
| Dim temp4 As String |
| Dim temp5 As String |
| |
| Dim zaehl As String |
| zaehl = 0 |
| |
| Dim xlApp As Variant |
| Dim xlSheet As Variant |
| Dim cursor As Integer |
| Dim recordcheck As String |
| |
| On Error Goto ERRORLABEL |
| Dim FileName As String |
| Dim DefaultFileName As String |
| DefaultFileName="c:\Austausch\bedarf.xls" |
| |
| NamePrompt$="Enter the complete Path and File Name of the Excel file to be imported:" &Chr(13) |
| FileName=Inputbox(NamePrompt$,"Import File Name Specification",DefaultFileName,100,100) |
| If FileName="" Then Exit Sub |
| 'Create an Excel object for the spreadsheet |
| 'It may be necessary to have the proper MS Office DLLs installed on the PC running this application |
| 'That is, the person must be able to open the XLS file with Excel |
| Set xlApp = CreateObject("excel.Application") |
| xlApp.Application.Workbooks.Open Filename |
| 'File not found will return ERR=213 and the routine will be ended |
| With xlApp.workbooks.Add |
| 'Not sure what this line is for, unless it's to be sure that at least one workbook is present in the XLS file |
| End With |
| 'Stop |
| Set xlSheet = xlApp.Workbooks(1).Worksheets(1) |
| recordcheck="x" |
| r=1 ' Row counter - first row contains fieldnames from the database; |
| 'these fieldnames are not needed as long as the spreadsheet follows a specified format |
| While recordcheck <>"ENDE" |
| 'Recordcheck = "0" when there is no value in the first cell of the row, if integer, or "", if string |
| 'Important - Set r to a value that will stop the import routine without missing any data, if the other criteria do not |
| 'For this example, six columns are imported |
| cursor=0 |
| r=r+1 |
| temp1=xlSheet.Cells(r,1).value |
| recordcheck=Cstr(temp1) |
| If recordcheck="0" Then Goto Finished ' Avoid generating empty record |
| |
| temp2=xlSheet.Cells(r,2).value |
| temp3=xlSheet.Cells(r,3).value |
| temp4=xlSheet.Cells(r,4).value |
| temp5 =xlSheet.Cells(r,5).value |
| temp6 =xlSheet.Cells(r,6).value |
| temp7 =xlSheet.Cells(r,7).value |
| |
| |
| 'The above lines lines could be combined with those below, but keep separate for ease in debugging until ready to finalize the code |
| Set doc = New NotesDocument(db) |
| doc.Form = "m_artikel" |
| doc.artikel= temp1 |
| doc.farbe= temp2 |
| doc.firma = temp3 |
| doc.artikelnummer = temp4 |
| doc.preis = temp5 |
| doc.kategorie = "Reinigung" |
| doc.lagerbestand =1 |
| doc.mindestbestand = 1 |
| doc.warnmenge = 1 |
| |
| Call Doc.Save(True, False) |
| |
| zaehl = zaehl + 1 |
| Print "Importiert :" + zaehl |
| Finished: |
| Wend |
| Goto SubClose |
| |
| ERRORLABEL: |
| 'Msgbox "An error was encountered." |
| 'Print "Error: " Error(), " Err:" Err(), " Erl:" Erl() |
| If Err=213 Then |
| Messagebox Filename & " was not found. Verify Path and Filename, then try the Import again." |
| Exit Sub |
| Else |
| Messagebox "Error" & Str(Err) & ": " & Error$ |
| End If |
| Resume Next |
| SubClose: |
| xlApp.activeworkbook.close |
| xlApp.Quit |
| Set xlapp = Nothing |
| Set view=db.getview("a_artikel_alle") |
| Call ws.viewrefresh |
| |
| End Sub |
Thema: Wie kann ich 20000 Datensätze aus Excel importieren? (Gelesen 5562 mal)