Question

我试图学习如何使用一系列物品，但我不太了解。我必须将数据从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

保存功能：

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文件的值会覆盖到db中。据我所知，如果我想添加很多对象，我必须使用数组。按照我对每个循环的方式，我使用相同的对象，实际上它不起作用。

我的Excel是这样的：

如何修复我的代码？

Answer 1

通常的方法是使用Collection个对象（在VBA中，Array相当不灵活。）

创建一个集合：

Dim MyCollection As New Collection

将对象添加到集合中：

MyCollection.Add MyObject

遍历集合中的所有对象（MyObject有Variant类型）

For Each MyObject In MyCollection
    'Do Something
Next MyObject

如何在vb

1 个答案: