Welcome to ShenZhenJia Knowledge Sharing Community for programmer and developer-Open, Learning and Share
menu search
person
Welcome To Ask or Share your Answers For Others

Categories

I have to bulk insert from Excel to SQL using VBA

I have written a function for that, but it is not working due to string max length.

Can anyone help? below is the code I have written:

Dim cn As Object: Set cn = CreateObject("ADODB.Connection")
Dim ProjectName, SourceType As String
ProjectName = ThisWorkbook.Sheets("Doorset Schedule").Range("B8")
SourceType = "Production Schedule"
''You should probably change Activeworkbook.Fullname to the
''name of your workbook
strCon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
& ActiveWorkbook.FullName _
 & ";Extended Properties=""Excel 12.0;HDR=Yes;IMEX=1"";"

cn.Open strCon

s = "INSERT INTO [ODBC;Description=TEST;DRIVER=SQL Server;"
s1 = "SERVER=Admin-hp;Trusted_Connection=Yes;"
s2 = "DATABASE=abcd].DoorSchedule ( [ProjectName],[SourceType]"
s3 = ",[A],[B],[C],[D],[E],[F],[G],[H],[I],[J],[K],[L],[M],[N],[O],[P],[Q],[R],[S],[T],[U],[V],[W],[X],[Y],[Z]"
s4 = ",[AA],[AB],[AC],[AD],[AE],[AF],[AG],[AH],[AI],[AJ],[AK],[AL],[AM],[AN],[AO],[AP],[AQ],[AR],[AS],[AT],[AU],[AV],[AW],[AX],[AY],[AZ]"
s5 = ",[BA],[BB],[BC],[BD],[BE],[BF],[BG],[BH],[BI],[BJ],[BK],[BL],[BM],[BN],[BO],[BP],[BQ],[BR],[BS],[BT],[BU],[BV],[BW],[BX],[BY],[BZ]"
s6 = ",[CA],[CB],[CC],[CD],[CE],[CF],[CG],[CH],[CI],[CJ],[CK],[CL],[CM],[CN],[CO],[CP],[CQ],[CR],[CS],[CT],[CU],[CV],[CW],[CX],[CY],[CZ]"
s7 = ",[DA],[DB],[DC],[DD],[DE],[DF],[DG],[DH],[DI],[DJ],[DK],[DL],[DM],[DN],[DO],[DP],[DQ],[DR],[DS],[DT],[DU],[DV],[DW],[DX],[DY],[DZ]"
s8 = ",[EA],[EB],[EC],[ED],[EE],[EF],[EG],[EH],[EI],[EJ],[EK],[EL],[EM],[EN],[EO],[EP],[EQ],[ER],[ES],[ET],[EU],[EV],[EW],[EX],[EY],[EZ]"
s9 = ",[FA],[FB],[FC],[FD],[FE],[FF],[FG],[FH],[FI],[FJ],[FK],[FL],[FM],[FN],[FO],[FP],[FQ],[FR],[FS],[FT],[FU],[FV],[FW],[FX],[FY],[FZ]"
s10 = ",[GA],[GB],[GC],[GD],[GE],[GF],[GG],[GH],[GI],[GJ],[GK],[GL],[GM],[GN],[GO]) "
s11 = " SELECT '" & ProjectName & "','" & SourceType & "',"
s12 = "a.col1 , a.Col2, a.Col3, a.col4, a.col5, a.col6, a.col7, a.col8, a.col9, a.col10, a.col11, a.col12, a.col13, a.col14, a.col15, a.col16, a.col17, a.col18, a.col19, a.col20, a.col21, a.col22, a.col23, a.col24, a.col25, a.col26, a.col27, a.col28, a.col29, a.col30, a.col31, a.col32, a.col33, a.col34, a.col35, a.col36, a.col37, a.col38, a.col39, a.col40, a.col41, a.col42, a.col43, a.col44, a.col45, a.col46, a.col47, a.col48, a.col49, a.col50, a.col51, a.col52, a.col53, a.col54, a.col55, a.col56, a.col57, a.col58, a.col59, a.col60, a.col61, a.col62, a.col63, a.col64, a.col65, a.col66, a.col67, a.col68, a.col69, a.col70, a.col71, a.col72, a.col73, a.col74, a.col75, a.col76, a.col77, a.col78, a.col79, a.col80,"
s13 = "a.col81,a.col82,a.col83,a.col84,a.col85,a.col86,a.col87,a.col88,a.col89,a.col90,a.col91,a.col92,a.col93,a.col94,a.col95,a.col96,a.col97,a.col98,a.col99,a.col100,a.col101,a.col102,a.col103,a.col104,a.col105,a.col106,a.col107,a.col108,a.col109,a.col110,a.col111,a.col112,a.col113,a.col114,a.col115,a.col116,a.col117,a.col118,a.col119,a.col120,a.col121,a.col122,a.col123,a.col124,a.col125,a.col126,a.col127,a.col128,a.col129,a.col130,a.col131,a.col132,a.col133,a.col134,a.col135,a.col136,a.col137,a.col138,a.col139,a.col140,a.col141,a.col142,a.col143,a.col144,a.col145,a.col146,a.col147,a.col148,a.col149,a.col150,a.col151,a.col152,a.col153,"
s14 = "a.col154,a.col155,a.col156,a.col157,a.col158,a.col159,a.col160,a.col161,a.col162,a.col163,a.col164,a.col165,a.col166,a.col167,a.col168,a.col169,a.col170,a.col171,a.col172,a.col173,a.col174,a.col175,a.col176,a.col177,a.col178,a.col179,a.col180,a.col181,a.col182,a.col183,a.col184,a.col185,a.col186,a.col187,a.col188,a.col189,a.col190,a.col191,a.col192,a.col193,a.col194,a.col195,a.col196,a.col197"
s15 = " FROM [Schedule$] a "
s16 = " WHERE a.Col1 Is not Null"



s17 = s + s1 + s2 + s3 + s4 + s5 + s6 + s7 + s8 + s9 + s10 + s11 + s12 + s13 + s14 + s15 + s16

Debug.Print (s + s1 + s2 + s3 + s4 + s5 + s6 + s7 + s8 + s9 + s10 + s11 + s12 + s13 + s14 + s15 + s16)

cn.Execute (s + s1 + s2 + s3 + s4 + s5 + s6 + s7 + s8 + s9 + s10 + s11 + s12 + s13 + s14 + s15 + s16)
See Question&Answers more detail:os

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
thumb_up_alt 0 like thumb_down_alt 0 dislike
205 views
Welcome To Ask or Share your Answers For Others

1 Answer

This is just a quick hack. I don't have enough information to refine the code. But is should definitely point you in the right direction.
Your code was trying to connect to the Excel Spreadsheet. The proper way is to connect to your database and use conn.execute to run your queries.

Sub TransferSpreadsheet()
    Dim destinationTable As String, rangeAddress As String, SqlQuery As String
    Dim conn
    Set conn = CreateObject("ADODB.Connection")
    conn.Provider = "OLEDB;Provider=Microsoft.ACE.OLEDB.12.0;"
    conn.Open "C:Users	inzinaDatafilesSpotlights.accdb"

    destinationTable = "TempTable"
    rangeAddress = getTableAddress("Sheet1")
    ExportExceltoAccessTable ThisWorkbook.Name, conn, destinationTable
    ' SqlQuery is the name of a "Saved Query" in your database
    'The "Saved Query" will insert the records from TempTable into whatever table you want
    SqlQuery = ""
    conn.Execute SqlQuery
End Sub


Private Sub ExportExceltoAccessTable(conn, destinationTable, rangeAddress)
    On Error Resume Next
    conn.Execute "DROP TABLE " & destinationTable & ";"
    On Error GoTo 0
    SqlQuery = "SELECT * INTO " & destinationTable & " FROM [Excel 8.0;HDR=YES;DATABASE=" & ThisWorkbook.FullName & "]." & rangeAddress
    conn.Execute SqlQuery
End Sub

Public Function getTableAddress(wsSheetName)
    Dim r As range
    Set r = Worksheets(wsSheetName).UsedRange
    getTableAddress = "[" & r.Worksheet.Name & "$" & r.Address(False, False) & "]"
End Function

Let me know if you have any questions


与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
thumb_up_alt 0 like thumb_down_alt 0 dislike
Welcome to ShenZhenJia Knowledge Sharing Community for programmer and developer-Open, Learning and Share
...