如何在vb中使用一个对象数组

我试图学习如何使用一个对象的数组,但我不明白。 我必须将数据从Excel文件导出到Access数据库。

Private Sub Import_XLS(ByVal fileData As String, ByVal dbEmpty As String, ByVal dbDest As String) If My.Computer.FileSystem.FileExists(dbDest) Then My.Computer.FileSystem.DeleteFile(dbDest) My.Computer.FileSystem.CopyFile(dbEmpty, dbDest) Dim capitoli As New cCapitoli Dim paragrafi As New cParagrafi Dim voci As New cVoci Dim total As Integer Dim fileStream As FileStream = New FileStream(fileData, FileMode.Open) Dim file(fileStream.Length) As Byte fileStream.Read(file, 0, fileStream.Length) fileStream.Close() Dim ExcelEngine As ExcelEngine = New ExcelEngine() Dim application As IApplication = ExcelEngine.Excel Dim workbook As IWorkbook = application.Workbooks.Open(New MemoryStream(file), ExcelOpenType.Automatic) Dim gecc As New Syncfusion.GridExcelConverter.GridExcelConverterControl Dim grid As New GridModel gecc.ExcelToGrid(fileData, grid.Model) Dim r, flag As Integer Dim oldCap, oldPar, oldVoce, oldSottovoce, vett(), stringaCap, stringaPar, stringaVoce, stringaSottovoce, c_Voc, p_Voc As String Dim capitolo As New cCapitolo Dim paragrafo As New cParagrafo Dim voce, sottoVoce As New cVoce For r = 2 To grid.RowCount - 1 vett = Split(grid(r, 1).Text) total = UBound(Split(grid(r, 1).Text, ".")) If grid(r, 1).Text <> "" Then Select Case total Case 0 'capitolo & paragrafo Dim cap As New cCapitolo flag = 1 oldCap = capitolo.Cod oldPar = paragrafo.Cod capitolo.Cod = grid(r, 1).Text.Substring(0, 1) capitolo.Descrizione = grid(r, 3).Text If Left(vett(0), 1) >= Chr(65) And Left(vett(0), 1) <= Chr(90) Then capitolo.Cod = Left(vett(0), 1) If capitolo.Cod <> oldCap Then capitoli.Add(cap) End If End If If grid(r, 3).Text.Length > 255 Then capitolo.Descrizione = grid(r, 3).Text.ToString.Substring(0, 252) + "..." Else capitolo.Descrizione = grid(r, 3).Text.ToString End If stringaCap = capitolo.Descrizione If Left(vett(0), 2) >= Chr(65) And Left(vett(0), 2) <= Chr(90) Then paragrafo.Cod = Left(vett(0), 2) If paragrafo.Cod <> oldPar Then paragrafi.Add(paragrafo) End If End If If grid(r, 3).Text.Length > 255 Then paragrafo.Descrizione = grid(r, 3).Text.ToString.Substring(0, 252) + "..." Else paragrafo.Descrizione = grid(r, 3).Text.ToString End If stringaPar = paragrafo.Descrizione Case 1 'voce Dim voc As New cVoce flag = 2 c_Voc = voc.Cod_Capitolo p_Voc = voc.Cod_Paragrafo voc.Cod_Capitolo = grid(r, 1).Text.Substring(0, 1) voc.Cod_Paragrafo = grid(r, 1).Text.Split(".")(0) voc.Cod_Voce = Right(vett(0), 2) If grid(r, 3).Text.Length > 255 Then voce.Descrizione = grid(r, 3).Text.ToString.Substring(0, 252) + "..." Else voce.Descrizione = grid(r, 3).Text.ToString End If stringaVoce = voce.Descrizione 'voce.Articolo = "voc.Cod_Capitolo & "." & voc.Cod_Paragrafo & "." & voc.Cod_Voce" voci.Add(voc) Case 2 'sottovoce flag = 3 oldSottovoce = voce.Cod_SottoVoce sottoVoce.Cod_SottoVoce = Left(vett(0), 2) sottoVoce.Cod_Voce = Left(vett(0), 5) 'come voce sottoVoce.Cod_Capitolo = grid(r, 1).Text.Substring(0, 1) sottoVoce.Cod_Paragrafo = grid(r, 1).Text.Split(".")(0) If sottoVoce.Cod_SottoVoce <> oldSottovoce Then voci.Add(sottoVoce) End If If grid(r, 3).Text.Length > 255 Then sottoVoce.Descrizione = grid(r, 3).Text.ToString.Substring(0, 252) + "..." Else sottoVoce.Descrizione = grid(r, 3).Text End If stringaSottovoce = sottoVoce.Descrizione Do While grid(r, 1).ToString = "" If grid(r, 1).ToString = "" And grid(r, 3).ToString IsNot Nothing Then Dim s As String s = grid(r, 3).ToString capitolo.Descrizione = grid((r - 1), 3).ToString & s End If Loop sottoVoce.Cod_Voce = Left(vett(0), 5) sottoVoce.Prezzo1 = grid(r, 12).Text sottoVoce.Prezzo2 = sottoVoce.Prezzo1 sottoVoce.Prezzo3 = sottoVoce.Prezzo1 sottoVoce.Prezzo4 = sottoVoce.Prezzo1 sottoVoce.UniMi = grid(r, 11).Text sottoVoce.Separatore = "." End Select Else If flag = 1 Then stringaCap = grid(r, 3).Text capitolo.Descrizione = stringaCap & grid(r, 3).Text stringaPar = grid(r, 3).Text paragrafo.Descrizione = stringaPar & grid(r, 3).Text End If If flag = 2 Then stringaVoce = grid(r, 3).Text voce.Descrizione = voce.Descrizione & stringaVoce End If If flag = 3 Then stringaSottovoce = grid(r, 3).Text sottoVoce.Descrizione = stringaSottovoce & grid(r, 3).Text End If End If Next r capitoli.Salva_DB(dbDest) paragrafi.Salva_DB(dbDest) voci.Salva_DB(dbDest) End Sub 'Import_XLS 

保存function:

 Public Sub Save_DB(ByVal PathDB As String) Dim db As New cDB db.connetti_DB(PathDB) db.get_rs("DELETE * FROM Capitoli") db.get_rs("SELECT * FROM Capitoli") Dim rs As ADODB.Recordset = db.RecordSet For Each cap As cCapitolo In Me rs.AddNew() rs("Descrizione").Value = cap.Descrizione rs("Cod").Value = cap.Cod rs.Update() Next rs db.close_DB() End Sub 'Save_DB Public Sub Save_DB(ByVal PathDB As String) Dim db As New cDB db.connetti_DB(PathDB) db.get_rs("DELETE * FROM Paragrafi") db.get_rs("SELECT * FROM Paragrafi") Dim rs As ADODB.Recordset = db.RecordSet For Each par As cParagrafo In Me rs.AddNew() rs("Descrizione").Value = par.Descrizione rs("Cod").Value = par.Cod rs.Update() Next par db.close_DB() End Sub 'Save_DB Public Sub Save_DB(ByVal PathDB As String) Dim db As New cDB db.connetti_DB(PathDB) db.get_rs("DELETE * FROM Voci") db.get_rs("SELECT Cod_Capitolo, Cod_Paragrafo, Descrizione, Cod_Voce, Cod_Sottovoce, UniMi, Prezzo1 FROM Voci") Dim rs As ADODB.Recordset = db.RecordSet For Each v As cVoce In Me rs.AddNew() rs("Cod_Voce").Value = v.Cod_Voce rs("Cod_SottoVoce").Value = v.Cod_SottoVoce rs("Cod_Capitolo").Value = v.Cod_Capitolo rs("Cod_Paragrafo").Value = v.Cod_Paragrafo If v.Prezzo1 IsNot Nothing Then rs("Prezzo1").Value = Val(v.Prezzo1.Replace(",", ".")) End If rs("UniMi").Value = v.UniMi rs.Update() Next v db.close_DB() End Sub Save_DB 

只有在Excel中有一行时,此代码才能正常工作。 显然我有不止一行,所以我的Excel文件的值被覆盖到数据库。 据我所知,如果我想添加很多的对象,我必须使用一个数组。 在我的每一个循环的方式我使用相同的对象,实际上它不工作。

我的Excel是这样的:

在这里输入图像描述

我如何修复我的代码?

通常的做法是使用一个对象集合(在VBA中,一个Array非常不灵活)。

创build一个集合:

 Dim MyCollection As New Collection 

将一个对象添加到集合中:

 MyCollection.Add MyObject 

迭代集合中的所有对象( MyObject具有Varianttypes)

 For Each MyObject In MyCollection 'Do Something Next MyObject