Creating Acess Database in VB

Question

Hello, if anyone could help me, I was used to create Database in VB5, like this bellow, but I need to rewrite all my programs in VB VS2017 :

Here the codes in VB5 to create a Database in Acess, if you guys could help me to convert it for the new version of VB in VS 2017 Ill apreciate it very much, thanks

'CRIANDO DATABASE ESFORÇOS
            '
            '        Dim MyDB As Database, MyWs As Workspace, IxFlds(2) As Field
            '        Dim i As Integer
            '
            '        On Error GoTo DataBaseError
            '
            '   'Cria o Arquivo Database
            '      Set MyWs = DBEngine.Workspaces(0)
            '      Set MyDB = MyWs.CreateDatabase("C:\Solonet VBF\Dados\" & Arquivo, dbLangGeneral, dbVersion25)'
            '
            '        'TABELA DADOS
            '        'Cria nova TableDef para a tabela Dados
            '        Dim DadTd As TableDef     'Tabela para Dados da Obra
            '        Dim DadFlds(5) As Field   'Campo da tabela Dados
            '      Set DadTd = MyDB.CreateTableDef("Dados")
            '   'Adiciona os campos para MyTableDef Dados
            '      Set DadFlds(0) = DadTd.CreateField("Obra", dbText)
            '        DadFlds(0).Size = 60
            '      Set DadFlds(1) = DadTd.CreateField("Cliente", dbText)
            '        DadFlds(1).Size = 60
            '      Set DadFlds(2) = DadTd.CreateField("Data", dbText)
            '        DadFlds(2).Size = 10
            '      Set DadFlds(3) = DadTd.CreateField("Projeto", dbText)
            '        DadFlds(3).Size = 30
            '      Set DadFlds(4) = DadTd.CreateField("Obs", dbText)
            '        DadFlds(4).Size = 60
            '      Set DadFlds(5) = DadTd.CreateField("Arquivo", dbText)
            '        DadFlds(5).Size = 30
            '
            '        'Adiciona os Campos à Tabela
            '        For i = 0 To 5
            '        DadTd.Fields.Append DadFlds(i)
            '        Next i
            '        'Adiciona TableDef to TableDefs collection.
            '        MyDB.TableDefs.Append DadTd
            '
            '        'TABELA PILARES
            '        'Cria nova TableDef para a tabela Pilares
            '        Dim PilTd As TableDef     'Tabela para Pilares
            '        Dim PilFlds(15) As Field  'Campos da tabela Pilares
            '        Dim PilIdx As Index       'Indice da table Pilares
            '      Set PilTd = MyDB.CreateTableDef("Pilares")
            '  'Adiciona campos para MyTableDef Pilares
            '      Set PilFlds(0) = PilTd.CreateField("Carg_ID", dbLong)
            '      Set PilFlds(1) = PilTd.CreateField("Entrada", dbLong)
            '      Set PilFlds(2) = PilTd.CreateField("Pilar", dbText)
            '      Set PilFlds(3) = PilTd.CreateField("Repetições", dbLong)'
            '      Set PilFlds(4) = PilTd.CreateField("LadoX", dbSingle')
            '      Set PilFlds(5) = PilTd.CreateField("LadoY", dbSingle)
            '      Set PilFlds(6) = PilTd.CreateField("CargaMax", dbSingle)
            '      Set PilFlds(7) = PilTd.CreateField("CargaMin", dbSingle)
            '      Set PilFlds(8) = PilTd.CreateField("MEx", dbSingle)
            '      Set PilFlds(9) = PilTd.CreateField("MEy", dbSingle)
            '      Set PilFlds(10) = PilTd.CreateField("HxE", dbSingle)
            '      Set PilFlds(11) = PilTd.CreateField("HEy", dbSingle)
            '      Set PilFlds(12) = PilTd.CreateField("Mx", dbSingle)
            '      Set PilFlds(13) = PilTd.CreateField("My", dbSingle)
            '      Set PilFlds(14) = PilTd.CreateField("Hx", dbSingle)
            '      Set PilFlds(15) = PilTd.CreateField("Hy", dbSingle)
            '        'Adiciona os Campos à Tabela
            '        For i = 0 To 15
            '        PilTd.Fields.Append PilFlds(i)
            '        Next i
            '   'Now add an Index
            '      Set PilIdx = PilTd.CreateIndex("Carg_ID")
            '        PilIdx.Primary = True
            '        PilIdx.Unique = True
            '      Set IxFlds(0) = PilIdx.CreateField("Carg_ID")
            '        'Append Field to Fields collection of Index object.
            '        PilIdx.Fields.Append IxFlds(0)
            '        'Append Index to Indexes collection.
            '        PilTd.Indexes.Append PilIdx
            '        'Append TableDef to TableDefs collection.
            '        MyDB.TableDefs.Append PilTd
            '
            '        'TABELA RESUMOCP
            '        'Cria nova TableDef para a tabela ResumoCP
            '        Dim ResTd As TableDef     'Tabela para Resumo
            '        Dim ResFlds(3) As Field   'Campo da tabela Resumo
            '      Set ResTd = MyDB.CreateTableDef("ResumoCP")
            '  'Adiciona campos para MyTableDef Pilares
            '      Set ResFlds(0) = ResTd.CreateField("Alternativa", dbLong)
            '      Set ResFlds(1) = ResTd.CreateField("Solução", dbText)
            '      Set ResFlds(2) = ResTd.CreateField("CustoR", dbSingle)
            '      Set ResFlds(3) = ResTd.CreateField("CustoU", dbSingle)
            '        'Adiciona os Campos à Tabela
            '        For i = 0 To 3
            '        ResTd.Fields.Append ResFlds(i)
            '        Next i
            '        MyDB.TableDefs.Append ResTd
            '
            '        'TABELA DE LEVCARGA
            '        'Cria nova TableDef para a tabela LEVCARGA
            '        Dim LevTd As TableDef     'Tabela para LEVCARGA
            '        Dim LevFlds(10) As Field   'Campo da tabela LEVCARGA
            '      Set LevTd = MyDB.CreateTableDef("LevCarga")
            '  'Adiciona campos para MyTableDef LEVCARGA
            '      Set LevFlds(0) = LevTd.CreateField("ATC", dbSingle)
            '      Set LevFlds(1) = LevTd.CreateField("ATerreo", dbSingle)
            '      Set LevFlds(2) = LevTd.CreateField("ASSolo", dbSingle)
            '      Set LevFlds(3) = LevTd.CreateField("ATipo", dbSingle)
            '      Set LevFlds(4) = LevTd.CreateField("NSub", dbSingle)
            '      Set LevFlds(5) = LevTd.CreateField("NElev", dbSingle)
            '      Set LevFlds(6) = LevTd.CreateField("NEsca", dbSingle)
            '      Set LevFlds(7) = LevTd.CreateField("Taxa", dbSingle)
            '      Set LevFlds(8) = LevTd.CreateField("Vento", dbSingle)
            '      Set LevFlds(9) = LevTd.CreateField("Cortina", dbSingle)
            '      Set LevFlds(10) = LevTd.CreateField("SCarg", dbSingle)
            '        'Adiciona os Campos à Tabela
            '        For i = 0 To 10
            '        LevTd.Fields.Append LevFlds(i)
            '        Next i
            '        MyDB.TableDefs.Append LevTd
            '
            '        prompt$ = "Arquivo " & Arquivo & " Criado"
            '        MsgBox(prompt$)
            '
            '       MyDB.Close

Answer 1

For your example, in VB.NET you will need to add a reference for Microsoft.Office.interop.access.dao to your project.

    Sub CreateAccessDatabase(ByVal Arquivo As String)

        Dim MyDB As Microsoft.Office.Interop.Access.Dao.Database
        Dim MyWs As Microsoft.Office.Interop.Access.Dao.Workspace
        Dim IxFlds(2) As Microsoft.Office.Interop.Access.Dao.Field
        Dim AccessDatabaseEngine As New Microsoft.Office.Interop.Access.Dao.DBEngine

        Dim i As Integer

        Try
            'Cria o Arquivo Database
            MyWs = AccessDatabaseEngine.Workspaces(0)
            MyDB = MyWs.CreateDatabase("C:\Solonet VBF\Dados\" & Arquivo, Microsoft.Office.Interop.Access.Dao.LanguageConstants.dbLangGeneral, Microsoft.Office.Interop.Access.Dao.DatabaseTypeEnum.dbVersion40)
            'TABELA DADOS
            'Cria nova TableDef para a tabela Dados
            Dim DadTd As Microsoft.Office.Interop.Access.Dao.TableDef     'Tabela para Dados da Obra
            Dim DadFlds(5) As Microsoft.Office.Interop.Access.Dao.Field   'Campo da tabela Dados
            DadTd = MyDB.CreateTableDef("Dados")
            'Adiciona os campos para MyTableDef Dados
            DadFlds(0) = DadTd.CreateField("Obra", Microsoft.Office.Interop.Access.Dao.DataTypeEnum.dbText)
            DadFlds(0).Size = 60
            DadFlds(1) = DadTd.CreateField("Cliente", Microsoft.Office.Interop.Access.Dao.DataTypeEnum.dbText)
            DadFlds(1).Size = 60
            DadFlds(2) = DadTd.CreateField("Data", Microsoft.Office.Interop.Access.Dao.DataTypeEnum.dbText)
            DadFlds(2).Size = 10
            DadFlds(3) = DadTd.CreateField("Projeto", Microsoft.Office.Interop.Access.Dao.DataTypeEnum.dbText)
            DadFlds(3).Size = 30
            DadFlds(4) = DadTd.CreateField("Obs", Microsoft.Office.Interop.Access.Dao.DataTypeEnum.dbText)
            DadFlds(4).Size = 60
            DadFlds(5) = DadTd.CreateField("Arquivo", Microsoft.Office.Interop.Access.Dao.DataTypeEnum.dbText)
            DadFlds(5).Size = 30

            'Adiciona os Campos à Tabela
            For i = 0 To 5
                DadTd.Fields.Append(DadFlds(i))
            Next i
            'Adiciona TableDef to TableDefs collection.
            MyDB.TableDefs.Append(DadTd)

            'TABELA PILARES
            'Cria nova TableDef para a tabela Pilares
            Dim PilTd As Microsoft.Office.Interop.Access.Dao.TableDef     'Tabela para Pilares
            Dim PilFlds(15) As Microsoft.Office.Interop.Access.Dao.Field  'Campos da tabela Pilares
            Dim PilIdx As Microsoft.Office.Interop.Access.Dao.Index       'Indice da table Pilares
            PilTd = MyDB.CreateTableDef("Pilares")
            'Adiciona campos para MyTableDef Pilares
            PilFlds(0) = PilTd.CreateField("Carg_ID", Microsoft.Office.Interop.Access.Dao.DataTypeEnum.dbLong)
            PilFlds(1) = PilTd.CreateField("Entrada", Microsoft.Office.Interop.Access.Dao.DataTypeEnum.dbLong)
            PilFlds(2) = PilTd.CreateField("Pilar", Microsoft.Office.Interop.Access.Dao.DataTypeEnum.dbText)
            PilFlds(3) = PilTd.CreateField("Repetições", Microsoft.Office.Interop.Access.Dao.DataTypeEnum.dbLong)
            PilFlds(4) = PilTd.CreateField("LadoX", Microsoft.Office.Interop.Access.Dao.DataTypeEnum.dbSingle)
            PilFlds(5) = PilTd.CreateField("LadoY", Microsoft.Office.Interop.Access.Dao.DataTypeEnum.dbSingle)
            PilFlds(6) = PilTd.CreateField("CargaMax", Microsoft.Office.Interop.Access.Dao.DataTypeEnum.dbSingle)
            PilFlds(7) = PilTd.CreateField("CargaMin", Microsoft.Office.Interop.Access.Dao.DataTypeEnum.dbSingle)
            PilFlds(8) = PilTd.CreateField("MEx", Microsoft.Office.Interop.Access.Dao.DataTypeEnum.dbSingle)
            PilFlds(9) = PilTd.CreateField("MEy", Microsoft.Office.Interop.Access.Dao.DataTypeEnum.dbSingle)
            PilFlds(10) = PilTd.CreateField("HxE", Microsoft.Office.Interop.Access.Dao.DataTypeEnum.dbSingle)
            PilFlds(11) = PilTd.CreateField("HEy", Microsoft.Office.Interop.Access.Dao.DataTypeEnum.dbSingle)
            PilFlds(12) = PilTd.CreateField("Mx", Microsoft.Office.Interop.Access.Dao.DataTypeEnum.dbSingle)
            PilFlds(13) = PilTd.CreateField("My", Microsoft.Office.Interop.Access.Dao.DataTypeEnum.dbSingle)
            PilFlds(14) = PilTd.CreateField("Hx", Microsoft.Office.Interop.Access.Dao.DataTypeEnum.dbSingle)
            PilFlds(15) = PilTd.CreateField("Hy", Microsoft.Office.Interop.Access.Dao.DataTypeEnum.dbSingle)
            'Adiciona os Campos à Tabela
            For i = 0 To 15
                PilTd.Fields.Append(PilFlds(i))
            Next i
            'Now add an Index
            PilIdx = PilTd.CreateIndex("Carg_ID")
            PilIdx.Primary = True
            PilIdx.Unique = True
            IxFlds(0) = PilIdx.CreateField("Carg_ID")
            'Append Field to Fields collection of Index object.
            PilIdx.Fields.Append(IxFlds(0))
            'Append Index to Indexes collection.
            PilTd.Indexes.Append(PilIdx)
            'Append TableDef to TableDefs collection.
            MyDB.TableDefs.Append(PilTd)

            'TABELA RESUMOCP
            'Cria nova TableDef para a tabela ResumoCP
            Dim ResTd As TableDef     'Tabela para Resumo
            Dim ResFlds(3) As Field   'Campo da tabela Resumo
            ResTd = MyDB.CreateTableDef("ResumoCP")
            'Adiciona campos para MyTableDef Pilares
            ResFlds(0) = ResTd.CreateField("Alternativa", Microsoft.Office.Interop.Access.Dao.DataTypeEnum.dbLong)
            ResFlds(1) = ResTd.CreateField("Solução", Microsoft.Office.Interop.Access.Dao.DataTypeEnum.dbText)
            ResFlds(2) = ResTd.CreateField("CustoR", Microsoft.Office.Interop.Access.Dao.DataTypeEnum.dbSingle)
            ResFlds(3) = ResTd.CreateField("CustoU", Microsoft.Office.Interop.Access.Dao.DataTypeEnum.dbSingle)
            'Adiciona os Campos à Tabela
            For i = 0 To 3
                ResTd.Fields.Append(ResFlds(i))
            Next i
            MyDB.TableDefs.Append(ResTd)

            'TABELA DE LEVCARGA
            'Cria nova TableDef para a tabela LEVCARGA
            Dim LevTd As Microsoft.Office.Interop.Access.Dao.TableDef     'Tabela para LEVCARGA
            Dim LevFlds(10) As Microsoft.Office.Interop.Access.Dao.Field   'Campo da tabela LEVCARGA
            LevTd = MyDB.CreateTableDef("LevCarga")
            'Adiciona campos para MyTableDef LEVCARGA
            LevFlds(0) = LevTd.CreateField("ATC", Microsoft.Office.Interop.Access.Dao.DataTypeEnum.dbSingle)
            LevFlds(1) = LevTd.CreateField("ATerreo", Microsoft.Office.Interop.Access.Dao.DataTypeEnum.dbSingle)
            LevFlds(2) = LevTd.CreateField("ASSolo", Microsoft.Office.Interop.Access.Dao.DataTypeEnum.dbSingle)
            LevFlds(3) = LevTd.CreateField("ATipo", Microsoft.Office.Interop.Access.Dao.DataTypeEnum.dbSingle)
            LevFlds(4) = LevTd.CreateField("NSub", Microsoft.Office.Interop.Access.Dao.DataTypeEnum.dbSingle)
            LevFlds(5) = LevTd.CreateField("NElev", Microsoft.Office.Interop.Access.Dao.DataTypeEnum.dbSingle)
            LevFlds(6) = LevTd.CreateField("NEsca", Microsoft.Office.Interop.Access.Dao.DataTypeEnum.dbSingle)
            LevFlds(7) = LevTd.CreateField("Taxa", Microsoft.Office.Interop.Access.Dao.DataTypeEnum.dbSingle)
            LevFlds(8) = LevTd.CreateField("Vento", Microsoft.Office.Interop.Access.Dao.DataTypeEnum.dbSingle)
            LevFlds(9) = LevTd.CreateField("Cortina", Microsoft.Office.Interop.Access.Dao.DataTypeEnum.dbSingle)
            LevFlds(10) = LevTd.CreateField("SCarg", Microsoft.Office.Interop.Access.Dao.DataTypeEnum.dbSingle)
            'Adiciona os Campos à Tabela
            For i = 0 To 10
                LevTd.Fields.Append(LevFlds(i))
            Next i
            MyDB.TableDefs.Append(LevTd)

            Dim prompt As String = "Arquivo " & Arquivo & " Criado"
            MsgBox(prompt)

            MyDB.Close()
        Catch ex As Exception
            MsgBox(ex.Message)
        End Try

    End Sub

---

Paul ~~~~ Microsoft MVP (Visual Basic)

Answer 2

Do you require further assistance? If not, then please close the thread by marking any answers that resolved your issue.

---

Paul ~~~~ Microsoft MVP (Visual Basic)