Forum Discussion

ayla-mamesh's avatar
ayla-mamesh
Copper Contributor
Jun 05, 2019

exporting multiple excel workbook with different names into access database

Dear Experts,

i am a telecom business financial analyst and i work on daily basis with excel for assessing financial viability of different offers to be offered to market. I usually receive the offers from different pricing teams in excel sheets tables in the following format:

Price    Local minutes    International Minutes    Data (GBs)    Customer Name     Business Case Ref

100$         1000                     200                            2                      XYZ                          5555

 

Due to the massive numbers of offers (assessments) we do, we did not have a single database to track all the offers that has been assessed (based on above table format). Accordingly, we have decided to put an Access Database to record and track these offers. The solution worked quite will. However, in order to maximise the time benefit, i thought of why not to put a command (Macro based) in the excel sheet of each business case assessed which will automatically export the above offer table in the same format into the Access Database. the challenge which i need help for is the following:

1- how do i create a command (VBA based) to export the data in the offer table?

2-what is the code to be written

3-should i save the excel workbooks with single unique names since each offer is customised for each customer with a unique Business Case reference number. How do i overcome this issue?

 

Appreciate your kind support.

Ayla

1 Reply

  • ayla-mamesh 

    Hi Ayla,

    here is a code from my german vba tanker. I think you can adopt it to your task.

     

    Sub DatenAusExcelTabelleHinzufügen()
    Dim conn As New ADODB.Connection
    Dim rst As ADODB.Recordset
    Dim objXlApp As Object
    Dim objMappe As Object
    Dim intZ As Integer

    On Error GoTo Fehler
    Set objXlApp = CreateObject("Excel.Application")
    Set objMappe = objXlApp.workbooks.Open(Application.CurrentProject.Path _
    & "\Mitarbeiter.xls")

    Set conn = CurrentProject.Connection
    Set rst = New ADODB.Recordset

    rst.Open "Personal", conn, adOpenKeyset, _
    adLockOptimistic

    For intZ = 2 To objMappe.sheets("Personal").usedrange.rows.Count
    With rst
    .AddNew
    .Fields("Nachname") = objMappe.sheets(1).cells(intZ, 2).Value
    .Fields("Vorname") = objMappe.sheets(1).cells(intZ, 3).Value
    .Fields("Position") = objMappe.sheets(1).cells(intZ, 4).Value
    .Fields("Anrede") = objMappe.sheets(1).cells(intZ, 5).Value
    .Fields("Geburtsdatum") = objMappe.sheets(1).cells(intZ, 6).Value
    .Fields("Einstellung") = objMappe.sheets(1).cells(intZ, 7).Value
    .Fields("Straße") = objMappe.sheets(1).cells(intZ, 8).Value
    .Fields("Ort") = objMappe.sheets(1).cells(intZ, 9).Value
    .Fields("Region") = objMappe.sheets(1).cells(intZ, 10).Value
    .Fields("PLZ") = objMappe.sheets(1).cells(intZ, 11).Value
    .Fields("Land") = objMappe.sheets(1).cells(intZ, 12).Value
    .Update
    End With
    Next intZ

    rst.Close
    objMappe.Close
    objXlApp.Quit

    Set objMappe = Nothing
    Set objXlApp = Nothing
    Set rst = Nothing
    Set conn = Nothing
    Exit Sub

    Fehler:
    MsgBox Err.Number & " " & Err.Description
    Set objMappe = Nothing
    Set objXlApp = Nothing
    End Sub

     

    Best regards from germany

    Bernd

    http://www.vba-tanker.com

Resources