Jun 05 2019 11:28 AM
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
Jun 05 2019 12:44 PM
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