- Option Explicit
- Public Sub CreateAllSheetsInsertScript()
- On Error GoTo ErrorHandler 'recordset and connection variables
- Dim Row As Long
- Dim Col As Integer
- 'To store all the columns available in the all of the worksheets
- Dim ColNames(100) As String
- Dim ColCount As Integer
- Dim MaxRow As Long
- Dim CellColCount As Integer
- Dim StringStore As String 'Temporary variable to store partial statement
- Dim InsertScriptHead As String
- Dim DBname As String
- Dim TableName As String
- Dim Ret As Long
- Dim Cnxn As New ADODB.Connection
- DBname = "DB1"
- TableName = "Table1"
- Cnxn.Open "Provider=SQLOLEDB;Data Source=localhost;Initial Catalog=" & DBname & ";Integrated Security=SSPI;"
- Application.ScreenUpdating = False
- Dim sh As Worksheet
- For Each sh In ActiveWorkbook.Sheets
- With sh
- .Select
- Col = 1
- Row = 1
- ColCount = 0
- 'Get Columns from the sheet
- Do Until .Cells(Row, Col) = "" 'Loop until you find a blank.
- ColNames(ColCount) = "[" & .Cells(Row, Col) & "]"
- ColCount = ColCount + 1
- Col = Col + 1
- Loop
- ColCount = ColCount - 1
- 'Inputs for the starting and ending point for the rows
- Row = 2
- MaxRow = .[A1].End(xlDown).Row
- CellColCount = 0
- '.Name will give the current active sheet name
- 'this can be treated as table name in the database
- InsertScriptHead = "INSERT INTO [dbo].[" & TableName & "] ( "
- Do While CellColCount <= ColCount
- InsertScriptHead = InsertScriptHead & ColNames(CellColCount)
- 'To avoid "," after last column
- If CellColCount <> ColCount Then
- InsertScriptHead = InsertScriptHead & " , "
- End If
- CellColCount = CellColCount + 1
- Loop
- InsertScriptHead = InsertScriptHead & " ) VALUES ( "
- Do While Row <= MaxRow
- 'Here it will print "insert into [TableName] ( [Col1] , [Col2] , ..."
- 'For printing the values for the above columns
- StringStore = InsertScriptHead
- CellColCount = 0
- Do While CellColCount <= ColCount
- StringStore = StringStore & IIf(Len(Trim(.Cells(Row, CellColCount + 1).Value)) = 0, "NULL", " '" & Replace(CStr(.Cells(Row, CellColCount + 1)), "'", "''") & "'")
- If CellColCount <> ColCount Then
- StringStore = StringStore & ", "
- End If
- CellColCount = CellColCount + 1
- Loop
- 'Here it will print "values( 'value1', 'value2', ..."
- Cnxn.Execute StringStore & ")"
- Row = Row + 1
- Loop
- End With
- Next sh
- Application.ScreenUpdating = True
- ' clean up
- Cnxn.Close
- Set Cnxn = Nothing
- MsgBox ("Successfully Done")
- Exit Sub
- ErrorHandler:
- ' clean up
- If Not Cnxn Is Nothing Then
- If Cnxn.State = adStateOpen Then Cnxn.Close
- End If
- Set Cnxn = Nothing
- If Err <> 0 Then
- MsgBox Err.Source & "-->" & Err.Description, , "Error"
- End If
- End Sub
来源: http://www.phpxs.com/code/1008736/