asked on
Const dbConStr As String = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=\\DTCHYB-ILSP001\C_MTG_Groups\Mandatory\Analysts - Working Files\Carol\Expert\LSB_analysis.accdb;Persist Security Info=False;"
Sub CopyToAccess()
Dim ws As Worksheet
Dim dbConn As Object
Dim dbCmd As Object
Dim lr As Long
Dim rng As Range, cell As Range
Set ws = Sheets("Sales_Summary")
lr = ws.Cells(Rows.Count, "BA").End(xlUp).Row
Set rng = ws.Range("BA1:BA" & lr)
Set dbConn = CreateObject("ADODB.Connection")
Set dbCmd = CreateObject("ADODB.Command")
On Error GoTo ErrHandler
dbConn.ConnectionString = dbConStr
dbConn.Open
dbCmd.ActiveConnection = dbConn
On Error GoTo 0
For Each cell In rng
On Error GoTo DataNotInserted
dbCmd.CommandText = "INSERT INTO Daily_Historical_Bid_Log (Trade_Date,Trade_Month,ClientID,Client,Tape_Amt,Concatenation) VALUES (" & _
"#" & cell.Value & "#," & _
"'" & cell.Offset(0, 1).Value & "'," & _
cell.Offset(0, 2).Value & "," & _
"'" & cell.Offset(0, 3).Value & "'," & _
cell.Offset(0, 4).Value & ")"
cell.Offset(0, 5).Value & "',")
dbCmd.Execute
Next cell
MsgBox "Data has been successfully inserted into Access Table.", vbInformation, "Done!"
Exit Sub
DataNotInserted:
MsgBox "Record is not inserted." & vbNewLine & Err.Number & vbNewLine & Err.Description
dbConn.Close
ErrHandler:
MsgBox "Something went wrong, unable to connect to the Access Database. " & vbNewLine & _
Err.Number & vbNewLine & Err.Description
End Sub
Copy-of-CopyExportToAccess.xlsm