Read from SQL Table and Copy cells to MS SQL Table

[abenitez77]

I want to connect to SQL server and loop thru a table that has a column called Path, which contains the path and file name of excel files. Then open the excel file and extract certain cells from the file and insert them into another table in SQL server db. How can I do this?

This is what i have so far...

Sub FScan()

With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
If .Show <> -1 Then MsgBox "No folder selected! Exiting sub...": Exit Sub
myDir = .SelectedItems(1)
End With


sFile = Dir(myDir + "\*.xls")
While sFile <> ""
sFile = Dir()
If Len(sFile) < 4 Then MsgBox "Done": Exit Sub
ReadWkBk (myDir & "\" & sFile)
Wend

End Sub



Sub ReadWkBk(sFile As String)

Dim sServer, sDBName As String
sServer = "USATL02PRSQ72"
sDBName = "TOYS_2010"

Dim ConnectionString As String
ConnectionString = _
"Provider=SQLOLEDB;" & _
"Data Source=" + sServer + ";" & _
"Initial Catalog=" + sDBName + ";" & _
"Integrated Security=SSPI"

' Connection assumes you have permission to connect to the named database as part of an AD
' group. Early binding assumes you have references set to the appropriate active X lib
Set Connection = CreateObject("ADODB.Connection")
Connection.Open ConnectionString

Dim wbIn As Workbook
Dim NewSetup As Variant, TypeOfSetup As Variant, Modification As Variant, TRUItem As Variant, VendorStyle As Variant
Dim ResourceName As Variant, QuoteDate As Variant, GuarAvailShipDate As Variant, ResourceNum As Variant, BuyerName As Variant, SubmittedBy As Variant

Dim NationalCostDom As Variant, NationalCostImp As Variant, LCL_FOB_Cost As Variant, FCL_FOB_Cost As Variant, NationalRetail As Variant, Markup As Variant

Dim FOB_Cost As Variant, Ocean_FRT As Variant, Duty As Variant, SubTotal As Variant, SubTotal2 As Variant, Misc_FOB As Variant, LandedCostTotal As Variant

Dim FOB_Ship As Variant, Ocean_Frt_cft As Variant, Duty_perc As Variant

Dim VendorContactName As Variant, VendorContactEmail As Variant, RepName As Variant, RepEmail As Variant

Dim AltRes1 As Variant, AltRes2 As Variant, AltRes3 As Variant, AltRes4 As Variant, AltRes5 As Variant
Dim ResName1 As Variant, ResName2 As Variant, ResName3 As Variant, ResName4 As Variant, ResName5 As Variant

Dim UPC1 As Variant, UPC2 As Variant, UPC3 As Variant, UPC4 As Variant, UPC5 As Variant, UPC6 As Variant, UPC7 As Variant
Dim UPC8 As Variant, UPC9 As Variant, UPC10 As Variant, UPC11 As Variant, UPC12 As Variant, UPC13 As Variant, UPC14 As Variant

Dim Cr_UPC1 As Variant, Cr_UPC2 As Variant, Cr_UPC3 As Variant, Cr_UPC4 As Variant, Cr_UPC5 As Variant, Cr_UPC6 As Variant, Cr_UPC7 As Variant
Dim Cr_UPC8 As Variant, Cr_UPC9 As Variant, Cr_UPC10 As Variant, Cr_UPC11 As Variant, Cr_UPC12 As Variant, Cr_UPC13 As Variant, Cr_UPC14 As Variant

Dim ItemDesc1 As Variant, ItemDesc2 As Variant, ItemDesc3 As Variant, ItemDesc4 As Variant, ItemDesc5 As Variant, ItemDesc6 As Variant, ItemDesc7 As Variant
Dim ItemDesc8 As Variant, ItemDesc9 As Variant, ItemDesc10 As Variant, ItemDesc11 As Variant, ItemDesc12 As Variant, ItemDesc13 As Variant, ItemDesc14 As Variant

Dim CasePack1 As Variant, CasePack2 As Variant, CasePack3 As Variant, CasePack4 As Variant, CasePack5 As Variant, CasePack6 As Variant, CasePack7 As Variant
Dim CasePack8 As Variant, CasePack9 As Variant, CasePack10 As Variant, CasePack11 As Variant, CasePack12 As Variant, CasePack13 As Variant, CasePack14 As Variant

Dim LeadUPC1 As Variant, LeadUPC2 As Variant, LeadUPC3 As Variant, LeadUPC4 As Variant, LeadUPC5 As Variant, LeadUPC6 As Variant, LeadUPC7 As Variant
Dim LeadUPC8 As Variant, LeadUPC9 As Variant, LeadUPC10 As Variant, LeadUPC11 As Variant, LeadUPC12 As Variant, LeadUPC13 As Variant, LeadUPC14 As Variant

Set wbIn = Workbooks.Open(sFile)
Dim rSheet As Range

'New Setup and modification
Set rSheet = wbIn.Worksheets(1).Range("I2:I3")
NewSetup = rSheet(1, 1).Value
Modificaiton = rSheet(2, 1).Value

'Import and TRU Item #
Set rSheet = wbIn.Worksheets(1).Range("B3:B5")
TypeOfSetup = rSheet(1, 1).Value
TRUItem = rSheet(3, 1).Value

'Vendor Style #
Set rSheet = wbIn.Worksheets(1).Range("AB5:AB5")
VendorStyle = rSheet(1, 1).Value

'Resource Vendor Name
Set rSheet = wbIn.Worksheets(1).Range("N6:N6")
ResourceName = rSheet(1, 1).Value

'Quote Date and Resource #
Set rSheet = wbIn.Worksheets(1).Range("AP3:AP5")
QuoteDate = rSheet(1, 1).Value
ResourceNum = rSheet(3, 1).Value

'Guaranteed Avail ship date and Buyer Name
Set rSheet = wbIn.Worksheets(1).Range("BA3:BA6")
GuarAvailShipDate = rSheet(1, 1).Value
BuyerName = rSheet(4, 1).Value

'Submitted by
Set rSheet = wbIn.Worksheets(1).Range("AY8:AY8")
SubmittedBy = rSheet(1, 1).Value

'National Cost, LCL FOB, FCL FOB, National Retail, Markup
Set rSheet = wbIn.Worksheets(1).Range("N37:N43")
NationalCostDom = rSheet(1, 1).Value
NationalCostImp = rSheet(2, 1).Value
LCL_FOB_Cost = rSheet(3, 1).Value
FCL_FOB_Cost = rSheet(4, 1).Value
NationalRetail = rSheet(5, 1).Value
Markup = rSheet(6, 1).Value

'FOB COST, OCEAN FRT, Duty, SubTotal, Landed cost, etc...
Set rSheet = wbIn.Worksheets(1).Range("L45:L51")
FOB_Cost = rSheet(1, 1).Value
Ocean_FRT = rSheet(2, 1).Value
Duty = rSheet(3, 1).Value
SubTotal = rSheet(4, 1).Value
SubTotal2 = rSheet(5, 1).Value
Misc_FOB = rSheet(6, 1).Value
LandedCostTotal = rSheet(7, 1).Value

'FOB ship, Ocean Frt, Duty
Set rSheet = wbIn.Worksheets(1).Range("B55:B55")
FOB_Shipt = rSheet(1, 1).Value

'Ocean Frt
Set rSheet = wbIn.Worksheets(1).Range("O55:O55")
Ocean_Frt_cft = rSheet(1, 1).Value

'Duty
Set rSheet = wbIn.Worksheets(1).Range("U55:U55")
Duty_perc = rSheet(1, 1).Value

'Vendor Contact Name
Set rSheet = wbIn.Worksheets(1).Range("M68:M68")
VendorContactName = rSheet(1, 1).Value

'Vendor Contact email
Set rSheet = wbIn.Worksheets(1).Range("L69:L69")
VendorContactEmail = rSheet(1, 1).Value

'Rep Name
Set rSheet = wbIn.Worksheets(1).Range("G70:G70")
RepName = rSheet(1, 1).Value

'Rep Email
Set rSheet = wbIn.Worksheets(1).Range("G71:G71")
RepEmail = rSheet(1, 1).Value

'UPC
Set rSheet = wbIn.Worksheets(1).Range("AC41:AC54")
UPC1 = rSheet(1, 1).Value
UPC2 = rSheet(2, 1).Value
UPC3 = rSheet(3, 1).Value
UPC4 = rSheet(4, 1).Value
UPC5 = rSheet(5, 1).Value
UPC6 = rSheet(6, 1).Value
UPC7 = rSheet(7, 1).Value
UPC8 = rSheet(8, 1).Value
UPC9 = rSheet(9, 1).Value
UPC10 = rSheet(10, 1).Value
UPC11 = rSheet(11, 1).Value
UPC12 = rSheet(12, 1).Value
UPC13 = rSheet(13, 1).Value
UPC14 = rSheet(14, 1).Value

'Create UPC
Set rSheet = wbIn.Worksheets(1).Range("AK41:AK54")
Cr_UPC1 = rSheet(1, 1).Value
Cr_UPC2 = rSheet(2, 1).Value
Cr_UPC3 = rSheet(3, 1).Value
Cr_UPC4 = rSheet(4, 1).Value
Cr_UPC5 = rSheet(5, 1).Value
Cr_UPC6 = rSheet(6, 1).Value
Cr_UPC7 = rSheet(7, 1).Value
Cr_UPC8 = rSheet(8, 1).Value
Cr_UPC9 = rSheet(9, 1).Value
Cr_UPC10 = rSheet(10, 1).Value
Cr_UPC11 = rSheet(11, 1).Value
Cr_UPC12 = rSheet(12, 1).Value
Cr_UPC13 = rSheet(13, 1).Value
Cr_UPC14 = rSheet(14, 1).Value

'Item Description
Set rSheet = wbIn.Worksheets(1).Range("AN41:AN54")
ItemDesc1 = rSheet(1, 1).Value
ItemDesc2 = rSheet(2, 1).Value
ItemDesc3 = rSheet(3, 1).Value
ItemDesc4 = rSheet(4, 1).Value
ItemDesc5 = rSheet(5, 1).Value
ItemDesc6 = rSheet(6, 1).Value
ItemDesc7 = rSheet(7, 1).Value
ItemDesc8 = rSheet(8, 1).Value
ItemDesc9 = rSheet(9, 1).Value
ItemDesc10 = rSheet(10, 1).Value
ItemDesc11 = rSheet(11, 1).Value
ItemDesc12 = rSheet(12, 1).Value
ItemDesc13 = rSheet(13, 1).Value
ItemDesc14 = rSheet(14, 1).Value

'Case Pack
Set rSheet = wbIn.Worksheets(1).Range("BI41:BI54")
CasePack1 = rSheet(1, 1).Value
CasePack2 = rSheet(2, 1).Value
CasePack3 = rSheet(3, 1).Value
CasePack4 = rSheet(4, 1).Value
CasePack5 = rSheet(5, 1).Value
CasePack6 = rSheet(6, 1).Value
CasePack7 = rSheet(7, 1).Value
CasePack8 = rSheet(8, 1).Value
CasePack9 = rSheet(9, 1).Value
CasePack10 = rSheet(10, 1).Value
CasePack11 = rSheet(11, 1).Value
CasePack12 = rSheet(12, 1).Value
CasePack13 = rSheet(13, 1).Value
CasePack14 = rSheet(14, 1).Value

'Lead UPC
Set rSheet = wbIn.Worksheets(1).Range("BK41:BK54")
LeadUPC1 = rSheet(1, 1).Value
LeadUPC2 = rSheet(2, 1).Value
LeadUPC3 = rSheet(3, 1).Value
LeadUPC4 = rSheet(4, 1).Value
LeadUPC5 = rSheet(5, 1).Value
LeadUPC6 = rSheet(6, 1).Value
LeadUPC7 = rSheet(7, 1).Value
LeadUPC8 = rSheet(8, 1).Value
LeadUPC9 = rSheet(9, 1).Value
LeadUPC10 = rSheet(10, 1).Value
LeadUPC11 = rSheet(11, 1).Value
LeadUPC12 = rSheet(12, 1).Value
LeadUPC13 = rSheet(13, 1).Value
LeadUPC14 = rSheet(14, 1).Value

'Alt Resource #
Set rSheet = wbIn.Worksheets(1).Range("AA56:AA60")
AltRes1 = rSheet(1, 1).Value
AltRes2 = rSheet(2, 1).Value
AltRes3 = rSheet(3, 1).Value
AltRes4 = rSheet(4, 1).Value
AltRes5 = rSheet(5, 1).Value

'Alt Resource Name
Set rSheet = wbIn.Worksheets(1).Range("AH56:AH60")
ResName1 = rSheet(1, 1).Value
ResName2 = rSheet(2, 1).Value
ResName3 = rSheet(3, 1).Value
ResName4 = rSheet(4, 1).Value
ResName5 = rSheet(5, 1).Value

Dim sSQL As String

' Build a SQL command

sSQL = "INSERT INTO AS_ItemOfferSheet (NewSetup,Modifications,TypeSetup,TRU_ItemNo,VendStyleNo,ResourceVendName,QuoteDate,ResourceNo,"
sSQL2 = "GuarAvailShipDate,BuyerName,SubmittedBy,NationalCost_Dom,NationalCost_Imp,LCL_FOB,FCL_FOB,NationalRetail,Markup,FOB_Cost,"
sSQL3 = "Ocean_FRT,Duty,SubTotal,SubTotal2,Misc_FOB,LandedCostTotal,FOB_Ship,Ocean_FRT_cft,Duty_Perc,VendorContact,VendorContactEmail,"
sSQL4 = "RepName,RepEmail,UPC1,UPC2,UPC3,UPC4,UPC5,UPC6,UPC7,UPC8,UPC9,UPC10,UPC11,UPC12,UPC13,UPC14,CreateUPC1,CreateUPC2,CreateUPC3,"
sSQL5 = "CreateUPC4,CreateUPC5,CreateUPC6,CreateUPC7,CreateUPC8,CreateUPC9,CreateUPC10,CreateUPC11,CreateUPC12,CreateUPC13,CreateUPC14,"
sSQL6 = "ItemDesc1,ItemDesc2,ItemDesc3,ItemDesc4,ItemDesc5,ItemDesc6,ItemDesc7,ItemDesc8,ItemDesc9,ItemDesc10,ItemDesc11,ItemDesc12,"
sSQL7 = "ItemDesc13,ItemDesc14,CasePack1,CasePack2,CasePack3,CasePack4,CasePack5,CasePack6,CasePack7,CasePack8,CasePack9,CasePack10,"
sSQL8 = "CasePack11,CasePack12,CasePack13,CasePack14,LeadUPC1,LeadUPC2,LeadUPC3,LeadUPC4,LeadUPC5,LeadUPC6,LeadUPC7,LeadUPC8,LeadUPC9,"
sSQL9 = "LeadUPC10,LeadUPC11,LeadUPC12,LeadUPC13,LeadUPC14,AltResNum1,AltResNum2,AltResNum3,AltResNum4,AltResNum5,ResName1,ResName2,"
sSQL10 = "ResName3,ResName4,ResName5)"

iSQL = "Values ('" & NewSetup & "','" & Modification & "','" & TypeOfSetup & "','" & TRUItem & "','" & VendorStyle & "','" & ResourceName & "','" & QuoteDate & "','" & ResourceNum
iSQL2 = ",'" & GuarAvailShipDate & "','" & BuyerName & "','" & SubmittedBy & "','" & NationalCostDom & "','" & NationalCostImp & "','" & LCL_FOB_Cost & "','" & FCL_FOB_Cost & "','" & NationalRetail & "','" & Markup & "','" & FOB_Cost
iSQL3 = ",'" & Ocean_FRT & "','" & Duty & "','" & SubTotal & "','" & SubTotal2 & "','" & Misc_FOB & "','" & LandedCostTotal & "','" & FOB_Ship & "','" & Ocean_Frt_cft & "','" & Duty_perc & "','" & VendorContactName & "','" & VendorContactEmail
iSQL4 = ",'" & RepName & "','" & RepEmail & "','" & UPC1 & "','" & UPC2 & "','" & UPC3 & "','" & UPC4 & "','" & UPC5 & "','" & UPC6 & "','" & UPC7 & "','" & UPC8 & "','" & UPC9 & "','" & UPC10 & "','" & UPC11 & "','" & UPC12 & "','" & UPC13 & "','" & CreateUPC1 & "','" & CreateUPC2 & "','" & CreateUPC3
iSQL5 = ",'" & CreateUPC4 & "','" & CreateUPC5 & "','" & CreateUPC6 & "','" & CreateUPC7 & "','" & CreateUPC8 & "','" & CreateUPC9 & "','" & CreateUPC10 & "','" & CreateUPC11 & "','" & CreateUPC12 & "','" & CreateUPC13 & "','" & CreateUPC14
iSQL6 = ",'" & ItemDesc1 & "','" & ItemDesc2 & "','" & ItemDesc3 & "','" & ItemDesc4 & "','" & ItemDesc5 & "','" & ItemDesc6 & "','" & ItemDesc7 & "','" & ItemDesc8 & "','" & ItemDesc9 & "','" & ItemDesc10 & "','" & ItemDesc11 & "','" & ItemDesc12
iSQL7 = ",'" & ItemDesc13 & "','" & ItemDesc14 & "','" & CasePack1 & "','" & CasePack2 & "','" & CasePack3 & "','" & CasePack4 & "','" & CasePack5 & "','" & CasePack6 & "','" & CasePack7 & "','" & CasePack8 & "','" & CasePack9 & "','" & CasePack10
iSQL8 = ",'" & CasePack11 & "','" & CasePack12 & "','" & CasePack13 & "','" & CasePack14 & "','" & LeadUPC1 & "','" & LeadUPC2 & "','" & LeadUPC3 & "','" & LeadUPC4 & "','" & LeadUPC5 & "','" & LeadUPC6 & "','" & LeadUPC7 & "','" & LeadUPC8 & "','" & LeadUPC9
iSQL9 = ",'" & LeadUPC10 & "','" & LeadUPC11 & "','" & LeadUPC12 & "','" & LeadUPC13 & "','" & LeadUPC14 & "','" & AltRes1 & "','" & AltRes2 & "','" & AltRes3 & "','" & AltRes4 & "','" & AltRes5 & "','" & ResName1 & "','" & ResName2
iSQL10 = ",'" & ResName3 & "','" & ResName4 & "','" & ResName5 & "')"


' Excecute the SQL
Set Recordset = Connection.Execute(sSQL & sSQL2 & sSQL3 & sSQL4 & sSQL5 & sSQL6 & sSQL7 & sSQL8 & sSQL9 & sSQL10 & iSQL & iSQL2 & iSQL3 & iSQL4 & iSQL5 & iSQL6 & iSQL7 & iSQL8 & iSQL9 & iSQL10)

Connection.Close
wbIn.Close

End Sub