• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 376
  • Last Modified:

Generate MDB from Excel on click of button (Mostly VBA)?

I have a workbook with several sheets.

Some sheets have data, some don't. There is a Master sheet which contains the sheet names and their status.. Final, Error, NA.

User would select a status for a sheet. For all sheets with status=Final, I would like to generate a single MDB file (with all the sheet data stored in separate MS Access tables). I would prefer if the MDB file is generated with a specific naming convention and allows the user to save on his computer.

Attached is a sample excel sheet which would probably give a clear idea of my request.

Any help is appreciated.

sample-mdb-conversion.xlsx
0
nainil
Asked:
nainil
  • 5
  • 5
3 Solutions
 
Randy DownsOWNERCommented:
0
 
nainilAuthor Commented:
Number-1:

Thank you. Is it possible to share a working example?
0
Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

 
Randy DownsOWNERCommented:
Here's a video that steps you through it - http://accessdatabasetutorial.com/2011/02/16/make-microsoft-access-open-up-excel-with-vba-video-tutorial/

Here's a macro - http://www.exceltip.com/st/Export_data_from_Excel_to_Access_(ADO)_using_VBA_in_Microsoft_Excel/425.html

If you want to export data to an Access table from an Excel worksheet,
the macro example below shows how this can be done:
Sub ADOFromExcelToAccess()
' exports data from the active worksheet to a table in an Access database
' this procedure must be edited before use
Dim cn As ADODB.Connection, rs As ADODB.Recordset, r As Long
    ' connect to the Access database
    Set cn = New ADODB.Connection
    cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; " & _
        "Data Source=C:\FolderName\DataBaseName.mdb;"
    ' open a recordset
    Set rs = New ADODB.Recordset
    rs.Open "TableName", cn, adOpenKeyset, adLockOptimistic, adCmdTable  
    ' all records in a table
    r = 3 ' the start row in the worksheet
    Do While Len(Range("A" & r).Formula) > 0
    ' repeat until first empty cell in column A
        With rs
            .AddNew ' create a new record
            ' add values to each field in the record
            .Fields("FieldName1") = Range("A" & r).Value
            .Fields("FieldName2") = Range("B" & r).Value
            .Fields("FieldNameN") = Range("C" & r).Value
            ' add more fields if necessary...
            .Update ' stores the new record
        End With
        r = r + 1 ' next row
    Loop
    rs.Close
    Set rs = Nothing
    cn.Close
    Set cn = Nothing
End Sub
The macro example assumes that your VBA project has added a reference to the ADO object library.
You can do this from within the VBE by selecting the menu Tools, References and selecting Microsoft
ActiveX Data Objects x.x Object Library.
Use ADO if you can choose between ADO and DAO for data import or export
0
 
nainilAuthor Commented:
I tried the same. However, it expects the MDB file to be present with the tables.

My request is:

To Create a new MDB file
To copy the Excel Sheet information by creating a NEW Access table
Sub GenerateMDB()

    Dim MDBFileName As String
    Dim cn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim r As Long
    Dim ds As Variant

    MDBFileName = Range("B14").Value
    ds = "Data Source=C:\" & MDBFileName & ";"
    
    MsgBox (ds)
    
    Set cn = New ADODB.Connection
    cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; " & ds
    
'   open a recordset
    Set rs = New ADODB.Recordset
    rs.Open "Codes", cn, adOpenKeyset, adLockOptimistic, adCmdTable
    
' all records in a table
    r = 2 ' the start row in the worksheet

    Do While Len(Range("A" & r).Formula) > 0
    ' repeat until first empty cell in column A
        With rs
            .AddNew ' create a new record
            ' add values to each field in the record
            .Fields("id") = Range("A" & r).Value
            .Fields("Name") = Range("B" & r).Value
            .Fields("Code") = Range("C" & r).Value
            ' add more fields if necessary...
            .Update ' stores the new record
        End With
        r = r + 1 ' next row
    Loop
    rs.Close
    Set rs = Nothing
    cn.Close
    Set cn = Nothing

    

End Sub

Open in new window

0
 
Randy DownsOWNERCommented:
This one creates a new mdb but you may need to change the references to match the macro above. It's using a connect string to OzGrid.mdb. The macro refers to MDBFileName.



Step 1
Add references to the following external libraries via the command Tools | References… in the VB-editor:
* Microsoft Ext. ADO 2.5 for DDL Security and later.
* Microsoft ActiveX Data Object 2.5 Library and later.

Step 2
Add a standard module to the workbook and then add the following procedure:

[vba]
Option Explicit

Const stDB As String = "c:\OzGrid.mdb"
Const stCon As String = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & stDB & ";"

Sub Create_MDB_Tables_On_The_Fly()
Dim xCat As ADOX.Catalog
Dim xTable As ADOX.Table

Dim wsSheet As Worksheet
Dim cTables As Collection
Dim vaValues As Variant
Dim lnRows As Long
Dim i As Long, j As Long, k As Long

With ActiveWorkbook
Set wsSheet = .Worksheets(1)
End With

With wsSheet
lnRows = .Range("C65536").End(xlUp).Row
'Populate the array.
vaValues = .Range("C2:G" & lnRows).Value
End With

'Instantiate the ADOX-object.
Set xCat = New ADOX.Catalog
'Instantiate the Collection-object.
Set cTables = New Collection

'Delete the existing MDB, if any.
On Error Resume Next
Kill stDB
On Error GoTo 0

'Create the MDB.
xCat.Create (stCon)

'Here we use an existing MDB and therefore we just connect to it.
'xCat.ActiveConnection = stCon

'For Your amusement You can print out the connection information in
'the Immediate Window:
Debug.Print xCat.ActiveConnection

'Populate the collection with unique Table names.
On Error Resume Next
For i = 1 To UBound(vaValues)
cTables.Add vaValues(i, 1), CStr(vaValues(i, 1))
Next i
On Error Resume Next

'Loop through the collection of unique Table names and
'append the Tables and the fields to the MDB.
For k = 1 To cTables.Count
Set xTable = New ADOX.Table
With xTable
'Name the table.
.Name = "tbl_" & cTables(k)
'Create the field which also is the Primary Key (PK) field for the Table.
.Columns.Append "ID", adInteger
'In order to access the properties we need to set the Parent Catalog.
.ParentCatalog = xCat
.Columns("ID").Properties("AutoIncrement").Value = True
'Append the PK.
.Keys.Append "PrimaryKey", adKeyPrimary, "ID"
'Loop through the variable vaValues and append these fields to the Table.
For j = 1 To UBound(vaValues)
If vaValues(j, 1) = cTables(k) Then
If vaValues(j, 3) = "Integer" Then
.Columns.Append vaValues(j, 2), adInteger
ElseIf vaValues(j, 3) = "Decimal" Then
.Columns.Append vaValues(j, 2), adNumeric
.Columns(vaValues(j, 2)).Precision = CLng(vaValues(j, 5))
ElseIf vaValues(j, 3) = "Date" Then
'Shortdate cannot be added and therefore the data should be
'formatted when the field's data is showed.
.Columns.Append vaValues(j, 2), adDate
Else 'Textfields
.Columns.Append vaValues(j, 2), adWChar, CLng(10)
End If
End If
Next j
'If we want to completely hide the Table when the MDB is open via MS Access
'we can set the following property.
'.Properties("Jet OLEDB:Table Hidden in Access").Value = True
End With
'Append the Table to the MDB.
xCat.Tables.Append xTable
Set xTable = Nothing
Next k

'Release the objects from the memory.
Set cTables = Nothing
Set xTable = Nothing: Set xCat = Nothing

MsgBox "The database have successfully been updated!"

End Sub
[/vba]

If we need we can also append foreign keys and also create relations between the tables. The above example shows how easily and fast we can create temporarily as well as permanent MDBs for different purposes.
0
 
nainilAuthor Commented:
I am not sure if this example actually imports data from Excel to Access.

I see it creates the tables and fields., nothing more.
0
 
nainilAuthor Commented:
The example as I tried out, simply created the tables in Access.
0
 
Randy DownsOWNERCommented:
OK, now that you have the tables & mdb, try using the macro to import data into it.

Sub ADOFromExcelToAccess()
' exports data from the active worksheet to a table in an Access database
' this procedure must be edited before use
Dim cn As ADODB.Connection, rs As ADODB.Recordset, r As Long
    ' connect to the Access database
    Set cn = New ADODB.Connection
    cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; " & _
        "Data Source=C:\FolderName\DataBaseName.mdb;"
    ' open a recordset
    Set rs = New ADODB.Recordset
    rs.Open "TableName", cn, adOpenKeyset, adLockOptimistic, adCmdTable  
    ' all records in a table
    r = 3 ' the start row in the worksheet
    Do While Len(Range("A" & r).Formula) > 0
    ' repeat until first empty cell in column A
        With rs
            .AddNew ' create a new record
            ' add values to each field in the record
            .Fields("FieldName1") = Range("A" & r).Value
            .Fields("FieldName2") = Range("B" & r).Value
            .Fields("FieldNameN") = Range("C" & r).Value
            ' add more fields if necessary...
            .Update ' stores the new record
        End With
        r = r + 1 ' next row
    Loop
    rs.Close
    Set rs = Nothing
    cn.Close
    Set cn = Nothing
End Sub
The macro example assumes that your VBA project has added a reference to the ADO object library.
You can do this from within the VBE by selecting the menu Tools, References and selecting Microsoft
ActiveX Data Objects x.x Object Library.
Use ADO if you can choose between ADO and DAO for data import or export    
0
 
nainilAuthor Commented:
Thanks for your help. Will try that.
0

Featured Post

Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

  • 5
  • 5
Tackle projects and never again get stuck behind a technical roadblock.
Join Now