I have an Access database with about 500,000 records. There is a specific column which has the transaction reference.
This is of the form:
Transaction_Ref
CDY1053N1
CDY1053N2
CDY1053N3
JFD215D1
JFD215D2
Where CDY1053N and JFD215D are customer references, and the 1,2,3, etc which follows is the transaction number.
What I am looking for is a loop which will update a column called "Group". This will go to row 1, and loop through the database to find transaction references similar to CDY1053N and assign a group ID, for example:
Transaction_Ref Group_ID
CDY1053N1 1
CDY1053N2 1
CDY1053N3 1
JFD215D1 2
JFD215D2 2
Any ideas please?
Thanks for the help.
This might not be the best or most elegant way to do this (particularly with the number of records you have), but this worked on my small set of test records.
I've assumed Transaction_Ref and Group_ID are in the same table and I've called that table tblTransactions.
I've also assumed that you might want to run this on new data so have nulled the Group_ID before looping through and resetting the values. This could mean that a different value for Group_ID gets assigned for a group of records (for example, were your records change order between subsequent runs of this sub).
If that's a problem you'll need to tweak this a bit.
Public Sub AssignGroupID()
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim sql As String
Dim i As Integer
Set db = CurrentDb
' Clear the Group_ID column (in case you want to run this more than once)
sql = "UPDATE tblTransactions Set Group_ID = Null"
db.Execute sql
' Open your table with the Transaction_Ref and Group_ID fields
Set rs = db.OpenRecordset("tblTransactions")
' Zero the counter
i = 0
' Start the loop (set it to end when it gets to the last record)
Do While Not rs.EOF
' Only update Group_IDs that haven't got a value yet
If IsNull(rs!Group_ID) Then
' Push the counter on
i = i + 1
' Update all Group_IDs with current counter number that
' match the customer reference of the current record
sql = "UPDATE tbltransactions Set Group_ID = " & i & " WHERE " _
& "Left(tblTransactions.Transaction_Ref, Len(tblTransactions.Transaction_Ref) -1) = '" _
& Left(rs!Transaction_Ref, Len(rs!Transaction_Ref) - 1) & "'"
db.Execute sql
End If
' Move to the next record
rs.MoveNext
Loop
'clean up
rs.Close
Set rs = Nothing
Set db = Nothing
End Sub
Good afternoon, whatever your timezone is ..
My question is,
Is there a way to select all tables? just like how we select all columns?
Something like
Dim cmdsql As String = "SELECT * FROM *"
Situation:
I have 4 tables inside the database ("which I would not know the names if my client changes it") So I need a better way how to do those.
I wanna SELECT all the columns, FROM all the tables store it in a dataset, so I can iterate
if it matches the search criteria.
EDIT: This is my search code by the way.
SearchDataset.Clear()
lstSearchResults.Items.Clear()
btnSearch.Enabled = False
Dim cmdsql As String = "SELECT * FROM *" '- This variable holds the SQL command.
'-----------------------------------------
' Connect to the current connection string
'----------------------------------------
SYSTEM_MainClient.dbcon.Open()
'-----------------------------------------
' Setup the Where Clause
'----------------------------------------
If cboSearchBy.Text = "StudentID" Then
SearchAdapter = New OleDb.OleDbDataAdapter(cmdsql + " WHERE " + cboSearchBy.Text + " = " + txtSearchbox.Text, SYSTEM_MainClient.dbcon)
ElseIf cboSearchBy.Text = "Age" Then
SearchAdapter = New OleDb.OleDbDataAdapter(cmdsql + " WHERE " + cboSearchBy.Text + " = " + txtSearchbox.Text, SYSTEM_MainClient.dbcon)
Else
SearchAdapter = New OleDb.OleDbDataAdapter(cmdsql + " WHERE " + cboSearchBy.Text + " like '" + txtSearchbox.Text + "'", SYSTEM_MainClient.dbcon)
End If
SearchAdapter.Fill(SearchDataset, "SearchResults")
SYSTEM_MainClient.dbcon.Close()
If SearchDataset.Tables("SearchResults").Rows.Count > 0 Then
For i = 0 To SearchDataset.Tables("SearchResults").Rows.Count - 1
lstSearchResults.Items.Add(SearchDataset.Tables("SearchResults").Rows(i).Item("Last_Name").ToString + ", " + SearchDataset.Tables("SearchResults").Rows(i).Item("First_Name").ToString)
Next
Else
SYSTEM_MainClient.ShowInformation("No records matched with the search '" + txtSearchbox.Text + "'.", "Database Search")
txtSearchbox.Clear()
End If
btnSearch.Enabled = True
Basically what I want to happen, select all from all tables, and fill it in the dataset and iterate inside the dataset if there are matching result names based on the search criteria with my where clause.
Here this Is the code to select all the tables from the ms access database
SELECT MSysObjects.Name AS table_name FROM MSysObjects
WHERE (((Left([Name],1))<>"~") AND ((Left([Name],4))<>"MSys") AND ((MSysObjects.Type) In (1,4,6)))
order by MSysObjects.Name
Making some alteration to this query will help to select columns of table
Working on a script in Microsoft VBA to take a massive flat database and split it between about 20 different tables. The script consists mainly of opening a table, checking every row in the flat database to make sure it's not a duplicate, then adding the necessary fields. Repeat for every table.
The first time I ran it everything was going well until I tried to process the name O'Malley. I think it's obvious what went wrong. A quick search on Google turned up this related StackOverflow post. I took their advice and added Replace(str, "'", "''") to every field before inputting it into the new tables. Now I've run into a new problem and Google is less helpful.
Replace(null, "'", "''") causes a run-time error, and the flat database is just riddled with null values. I can add an extra line above every Replace() call to check IsNull() and if so put null into the database instead of Replace(str, "'", "''"), although I would prefer a solution that can fit into a single line if possible. Is there any more elegant way to solve this dilemma, or will I need 216 If statements in my code?
EDIT -
Another reason that I'm searching for a more elegant solution is my duplicate checking code. At the moment I have something like the following:
'Check for duplicates
'Assume student is duplicate if it shares:
' (StudentName and School) or SSN
Set rstDuplicate = CurrentDb.OpenRecordset("select * from Student where (StudentName = '" & Replace(rstFrom("Student").Value, "'", "''") & "' AND School = '" & Replace(rstFrom("School").Value, "'", "''") & "') OR SSN = '" & Replace(rstFrom("Social").Value, "'", "''") & "'")
If rstDuplicate.RecordCount = 0 Then
'Duplicate was not found
rstTo.AddNew
' Add fields to the new table
rstTo.Update
End If
Since the Replace() calls are inline with the duplicate checking, if I were to instead use If statements to check for null then I would have to either save the result to a string or update to flat database. A function that returns Replace(str, "'", "''") OR null without the need for extra variables would be ideal.
If you want to keep everything inline, you can use an immediate If function (IIf):
IIf(IsNull(rstFrom("Student").Value), " Is Null", "= " & Replace(rstFrom("Student").Value)
That will be a nightmare to read and maintain, though. You are better off writing your own function to handle the change in comparison operator as well as the apostrophe escaping:
Function CompFld(Val As Variant) As String
If IsNull(Val) Then
CompFld = " Is Null "
Else
CompFld = "= '" & Replace(Val, "'", "''") & "' "
End If
End Function
Use it as so:
Dim SQL As String
SQL = "SELECT * FROM Student " & _
"WHERE (StudentName " & CompFld(rstFrom("Student").Value) & " AND " & _
" School " & CompFld(rstFrom("School").Value) & ") " & _
" OR (SSN " & CompFld(rstFrom("Social").Value) & ") "
Set rstDuplicate = CurrentDb.OpenRecordset(SQL)
If rstDuplicate.RecordCount = 0 Then
'Duplicate was not found
rstTo.AddNew
' Add fields to the new table
rstTo.Update
End If
A terse, yet ugly little gem handed down to me from ages ago:
Replace(str & "", "'", "''")
Appending an empty string to a null value returns an empty string in VBA, and won't modify a non-empty string.
Access' database engine will accept either single or double quotes as delimiters for string values in queries. So instead of ...
SELECT * FROM Student WHERE StudentName = 'O''Malley'
... you can do this ...
SELECT * FROM Student WHERE StudentName = "O'Malley"
That would allow you to handle inputs which contain apostrophes. OTOH, if your string inputs also contain double quotes, this will break.
I suspect you may have more going on than just the apostrophe issue, but I don't understand your big picture. You seem to be opening a third DAO recordset for each record in rstFrom, to check whether a match exists in the Student table. I would use DCount() instead.
Dim strCriteria As String
strCriteria = "StudentName = ""O'Malley"" AND School = ""foo"""
If DCount("*", "Student", strCriteria) = 0 Then
'no match found --> add it '
End If
In a SQL database I have a table, Table1. This table is related to another table, Table2 which in turn is related to Table3. There is a query Query1 that selects certain records from Table1.
This database is linked to in an Access database project
A form Table1Data is based on Table1, with a datasheet containing related Table2 data (and subsequently Table3 data). This form is opened by another form (Switchboard). The problem comes when the form is opened. I want the form to be filtered, but when I set up a macro and open the form and set the Filter to Query1, the data in the form is not filtered. Why does this happen, is this not the way to do it? Query1 selects all the columns from Table1, so mismatching columns should not be an issue.
Additionally I want to lock it down - only certain people can execute Query1, same with other queries (Query2, Query3 etc). So they can only edit the data that they are permitted to edit.
My preferred solution is to set the recordsource in the Form Open event. This gives me the most control over what is going on.
Here is my boilerplate for doing this. It also includes looking up the OpenArgs which are passed on calling the form. You can just comment out or remove the If/Then statement if you aren't looking to specify anything from the calling form in your SQL.
Private Sub Form_Open(Cancel As Integer)
' Comments :
' Parameters: Cancel -
' Modified :
' --------------------------------------------------
On Error GoTo Err_Form_Open
Dim strSQL As String
Dim strVariable As String
Dim strDateVariable As String
Dim dteDateVariable As String
Dim i As Integer
Dim n As Integer
'Get variables from Left and right of | in OpenArgs
If Not (IsNull(Me.OpenArgs)) Then
i = InStr(1, Me.OpenArgs, "|")
n = Len(Me.OpenArgs)
strVariable = Left(Me.OpenArgs, n - (n - i + 1))
strDateVariable = Right(Me.OpenArgs, (n - i))
dteDateVariable = CDate(strDateVariable)
Else
GoTo Exit_Form_Open
End If
strSQL = "SELECT ... " _
& "FROM ... " _
& "WHERE (((Field1)='" & strVariable & "') " _
& " AND ((Field2)=#" & dteDateVariable & "#));"
Me.RecordSource = strSQL
Me.Requery
Exit_Form_Open:
Exit Sub
Err_Form_Open:
Select Case Err.Number
Case Else
Call ErrorLog(Err.Number, Err.Description, "Form_Open", "frmName", Erl)
GoTo Exit_Form_Open
End Select
End Sub
I have a bunch of rows in Excel that I want to paste into a new table in MS SQL. Is there a simple way ?
If you have SQL Server Management Studio, you can just Copy from Excel and Paste into the table in Management Studio, using your mouse. Just
Go to the table you want to paste into.
Select "Edit Top 200 Rows".
Right-click anywhere and select Paste.
Before you do this, you must match the columns between Excel and Management Studio. Also, you must place any non-editable columns last (right-most) using the Table Designer in Management Studio.
The whole procedure takes seconds (to set-up and start - not necessarily to execute) and doesn't require any SQL statements.
Regarding empty database tables and SSMS v18.1+.
I have used this technique successfully in the past:
Using Excel to generate Inserts for SQL Server
(...) Skip a column (or use it for notes) and then type something like the
following formula in it:
="insert into tblyourtablename (yourkeyID_pk, intmine, strval) values ("&A4&", "&B4&", N'"&C4&"')"
Now you’ve got your insert statement for
a table with your primary key (PK), an integer and a unicode string. (...)
Excel
In Excel, highlight and copy the data you want to paste into SQL.
SQL
Create the table with the desired column names and give you table a name.
*Make sure Identity Specification is Yes, so it will auto increment your
Identity column.
Find your table, and right click on it and choose Edit Top 200 Rows from the dialog-box.
Right click on the empty row with the * sign and select paste from the dialog-box
For future references:
You can copy-paste data from en excel-sheet to an SQL-table by doing so:
Select the data in Excel and press Ctrl + C
In SQL Server Management Studio right click the table and choose Edit Top 200 Rows
Scroll to the bottom and select the entire empty row by clicking on the row header
Paste the data by pressing Ctrl + V
Note: Often tables have a first column which is an ID-column with an auto generated/incremented ID. When you paste your data it will start inserting the leftmost selected column in Excel into the leftmost column in SSMS thus inserting data into the ID-column. To avoid that keep an empty column at the leftmost part of your selection in order to skip that column in SSMS. That will result in SSMS inserting the default data which is the auto generated ID.
Furthermore you can skip other columns by having empty columns at the same ordinal positions in the Excel sheet selection as those columns to be skipped. That will make SSMS insert the default value (or NULL where no default value is specified).
I have developed an Excel VBA Macro for cutting and pasting any selection from Excel into SQL Server, creating a new table. The macro is great for quick and dirty table creations up to a few thousand rows and multiple columns (It can theoretically manage up to 200 columns). The macro attempts to automatically detect header names and assign the most appropriate datatype to each column (it handles varchar columns upto 1000 chars).
Recommended Setup procedure:
Make sure Excel is enabled to run macros. (File->Options->Trust Center->Trust Center Settings->Macro Settings->Enable all macros..)
Copy the VBA code below to the module associated with your personal workbook (So that the Macro will be available for all worksheets)
Assign an appropriate keystroke to the macro ( I have assigned Ctrl Shift X)
Save your personal workbook
Use of Macro
Select the cells in Excel (including column headers if they exist) to be transferred to SQL
Press the assigned keyword combination that you have assigned to run the macro
Follow the prompts. (Default table name is ##Table)
Paste the clipboard contents into a SSMS window and run the generated SQL code.
BriFri 238
VBA Code:
Sub TransferToSQL()
'
' TransferToSQL Macro
' This macro prepares data for pasting into SQL Server and posts it to the clipboard for inserting into SSMS
' It attempts to automatically detect header rows and does a basic analysis of the first 15 rows to determine the most appropriate datatype to use handling text entries upto 1000 chars.
'
' Max Number of Columns: 200
'
' Keyboard Shortcut: Ctrl+Shift+X
'
' ver Date Reason
' === ==== ======
' 1.6 06/2012 Fixed bug that prevented auto exit if no selection made / auto exit if blank Tablename entered or 'cancel' button pressed
' 1.5 02/2012 made use of function fn_ColLetter to retrieve the Column Letter for a specified column
' 1.4 02/2012 Replaces any Tabs in text data to spaces to prevent Double quotes being output in final results
' 1.3 02/2012 Place the 'drop table if already exists' code into a separate batch to prevent errors when inserting new table with same name but different shape and > 100 rows
' 1.2 01/2012 If null dates encountered code to cast it as Null rather than '00-Jan-1900'
' 1.1 10/2011 Code to drop the table if already exists
' 1.0 03/2011 Created
Dim intLastRow As Long
Dim intlastColumn As Integer
Dim intRow As Long
Dim intDataStartRow As Long
Dim intColumn As Integer
Dim strKeyWord As String
Dim intPos As Integer
Dim strDataTypeLevel(4) As String
Dim strColumnHeader(200) As String
Dim strDataType(200) As String
Dim intRowCheck As Integer
Dim strFormula(20) As String
Dim intHasHeaderRow As Integer
Dim strCellRef As String
Dim intFormulaCount As Integer
Dim strSQLTableName As String
Dim strSQLTableName_Encap As String
Dim intdataTypelevel As Integer
Const strConstHeaderKeyword As String = "ID,URN,name,Title,Job,Company,Contact,Address,Post,Town,Email,Tele,phone,Area,Region,Business,Total,Month,Week,Year,"
Const intConstMaxBatchSize As Integer = 100
Const intConstNumberRowsToAnalyse As Integer = 100
intHasHeaderRow = 0
strDataTypeLevel(1) = "VARCHAR(1000)"
strDataTypeLevel(2) = "FLOAT"
strDataTypeLevel(3) = "INTEGER"
strDataTypeLevel(4) = "DATETIME"
' Use current selection and paste to new temp worksheet
Selection.Copy
Workbooks.Add ' add temp 'Working' Workbook
' Paste "Values Only" back into new temp workbook
Range("A3").Select ' Goto 3rd Row
Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False ' Copy Format of Selection
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False ' Copy Values of Selection
ActiveCell.SpecialCells(xlLastCell).Select ' Goto last cell
intLastRow = ActiveCell.Row
intlastColumn = ActiveCell.Column
' Check to make sure that there are cells which are selected
If intLastRow = 3 And intlastColumn = 1 Then
Application.DisplayAlerts = False ' Temporarily switch off Display Alerts
ActiveWindow.Close ' Delete newly created worksheet
Application.DisplayAlerts = True ' Switch display alerts back on
MsgBox "*** Please Make selection before running macro - Terminating ***", vbOKOnly, "Transfer Data to SQL Server"
Exit Sub
End If
' Prompt user for Name of SQL Server table
strSQLTableName = InputBox("SQL Server Table Name?", "Transfer Excel Data To SQL", "##Table")
' if blank table name entered or 'Cancel' selected then exit
If strSQLTableName = "" Then
Application.DisplayAlerts = False ' Temporarily switch off Display Alerts
ActiveWindow.Close ' Delete newly created worksheet
Application.DisplayAlerts = True ' Switch display alerts back on
Exit Sub
End If
' encapsulate tablename with square brackets if user has not already done so
strSQLTableName_Encap = Replace(Replace(Replace("[" & Replace(strSQLTableName, ".", "].[") & "]", "[]", ""), "[[", "["), "]]", "]")
' Try to determine if the First Row is a header row or contains data and if a header load names of Columns
Range("A3").Select
For intColumn = 1 To intlastColumn
' first check to see if the first row contains any pure numbers or pure dates
If IsNumeric(ActiveCell.Value) Or IsDate(ActiveCell.Value) Then
intHasHeaderRow = vbNo
intDataStartRow = 3
Exit For
Else
strColumnHeader(intColumn) = ActiveCell.Value
ActiveCell.Offset(1, 0).Range("A1").Select ' go to the row below
If IsNumeric(ActiveCell.Value) Or IsDate(ActiveCell.Value) Then
intHasHeaderRow = vbYes
intDataStartRow = 4
End If
ActiveCell.Offset(-1, 0).Range("A1").Select ' go back up to the first row
If intHasHeaderRow = 0 Then ' if still not determined if header exists: Look for header using keywords
intPos = 1
While intPos < Len(strConstHeaderKeyword) And intHasHeaderRow = 0
strKeyWord = Mid$(strConstHeaderKeyword, intPos, InStr(intPos, strConstHeaderKeyword, ",") - intPos)
If InStr(1, ActiveCell.Value, strKeyWord) > 0 Then
intHasHeaderRow = vbYes
intDataStartRow = 4
End If
intPos = InStr(intPos, strConstHeaderKeyword, ",") + 1
Wend
End If
End If
ActiveCell.Offset(0, 1).Range("A1").Select ' Goto next column
Next intColumn
' If auto header row detection has failed ask the user to manually select
If intHasHeaderRow = 0 Then
intHasHeaderRow = MsgBox("Does current selection have a header row?", vbYesNo, "Auto header row detection failure")
If intHasHeaderRow = vbYes Then
intDataStartRow = 4
Else
intDataStartRow = 3
End If
End If
' *** Determine the Data Type of each Column ***
' Go thru each Column to find Data types
If intLastRow < intConstNumberRowsToAnalyse Then ' Check the first intConstNumberRowsToAnalyse rows or to end of selection whichever is less
intRowCheck = intLastRow
Else
intRowCheck = intConstNumberRowsToAnalyse
End If
For intColumn = 1 To intlastColumn
intdataTypelevel = 5
For intRow = intDataStartRow To intRowCheck
Application.Goto Reference:="R" & CStr(intRow) & "C" & CStr(intColumn)
If ActiveCell.Value = "" Then ' ignore blank (null) values
ElseIf IsDate(ActiveCell.Value) = True And Len(ActiveCell.Value) >= 8 Then
If intdataTypelevel > 4 Then intdataTypelevel = 4
ElseIf IsNumeric(ActiveCell.Value) = True And InStr(1, CStr(ActiveCell.Value), ".") = 0 And (Left(CStr(ActiveCell.Value), 1) <> "0" Or ActiveCell.Value = "0") And Len(ActiveCell.Value) < 10 Then
If intdataTypelevel > 3 Then intdataTypelevel = 3
ElseIf IsNumeric(ActiveCell.Value) = True And InStr(1, CStr(ActiveCell.Value), ".") >= 1 Then
If intdataTypelevel > 2 Then intdataTypelevel = 2
Else
intdataTypelevel = 1
Exit For
End If
Next intRow
If intdataTypelevel = 5 Then intdataTypelevel = 1
strDataType(intColumn) = strDataTypeLevel(intdataTypelevel)
Next intColumn
' *** Build up the SQL
intFormulaCount = 1
If intHasHeaderRow = vbYes Then ' *** Header Row ***
Application.Goto Reference:="R4" & "C" & CStr(intlastColumn + 1) ' Goto next column in first data row of selection
strFormula(intFormulaCount) = "= ""SELECT "
For intColumn = 1 To intlastColumn
If strDataType(intColumn) = "DATETIME" Then ' Code to take Excel Dates back to text
strCellRef = "Text(" & fn_ColLetter(intColumn) & "4,""dd-mmm-yyyy hh:mm:ss"")"
ElseIf strDataType(intColumn) = "VARCHAR(1000)" Then
strCellRef = "SUBSTITUTE(" & fn_ColLetter(intColumn) & "4,""'"",""''"")" ' Convert any single ' to double ''
Else
strCellRef = fn_ColLetter(intColumn) & "4"
End If
strFormula(intFormulaCount) = strFormula(intFormulaCount) & "CAST('""& " & strCellRef & " & ""' AS " & strDataType(intColumn) & ") AS [" & strColumnHeader(intColumn) & "]"
If intColumn < intlastColumn Then
strFormula(intFormulaCount) = strFormula(intFormulaCount) + ", "
Else
strFormula(intFormulaCount) = strFormula(intFormulaCount) + " UNION ALL """
End If
' since each cell can only hold a maximum no. of chars if Formula string gets too big continue formula in adjacent cell
If Len(strFormula(intFormulaCount)) > 700 And intColumn < intlastColumn Then
strFormula(intFormulaCount) = strFormula(intFormulaCount) + """"
intFormulaCount = intFormulaCount + 1
strFormula(intFormulaCount) = "= """
End If
Next intColumn
' Assign the formula to the cell(s) just right of the selection
For intColumn = 1 To intFormulaCount
ActiveCell.Value = strFormula(intColumn)
If intColumn < intFormulaCount Then ActiveCell.Offset(0, 1).Range("A1").Select ' Goto next column
Next intColumn
' Auto Fill the formula for the full length of the selection
ActiveCell.Offset(0, -intFormulaCount + 1).Range("A1:" & fn_ColLetter(intFormulaCount) & "1").Select
If intLastRow > 4 Then Selection.AutoFill Destination:=Range(fn_ColLetter(intlastColumn + 1) & "4:" & fn_ColLetter(intlastColumn + intFormulaCount) & CStr(intLastRow)), Type:=xlFillDefault
' Go to start row of data selection to add 'Select into' code
ActiveCell.Value = "SELECT * INTO " & strSQLTableName_Encap & " FROM (" & ActiveCell.Value
' Go to cells above data to insert code for deleting old table with the same name in separate SQL batch
ActiveCell.Offset(-1, 0).Range("A1").Select ' go to the row above
ActiveCell.Value = "GO"
ActiveCell.Offset(-1, 0).Range("A1").Select ' go to the row above
If Left(strSQLTableName, 1) = "#" Then ' temp table
ActiveCell.Value = "IF OBJECT_ID('tempdb.." & strSQLTableName & "') IS NOT NULL DROP TABLE " & strSQLTableName_Encap
Else
ActiveCell.Value = "IF OBJECT_ID('" & strSQLTableName & "') IS NOT NULL DROP TABLE " & strSQLTableName_Encap
End If
' For Big selections (i.e. several 100 or 1000 rows) SQL Server takes a very long time to do a multiple union - Split up the table creation into many inserts
intRow = intConstMaxBatchSize + 4 ' add 4 to make sure 1st batch = Max Batch Size
While intRow < intLastRow
Application.Goto Reference:="R" & CStr(intRow - 1) & "C" & CStr(intlastColumn + intFormulaCount) ' Goto Row before intRow and the last column in formula selection
ActiveCell.Value = Replace(ActiveCell.Value, " UNION ALL ", " ) a") ' Remove last 'UNION ALL'
Application.Goto Reference:="R" & CStr(intRow) & "C" & CStr(intlastColumn + 1) ' Goto intRow and the first column in formula selection
ActiveCell.Value = "INSERT " & strSQLTableName_Encap & " SELECT * FROM (" & ActiveCell.Value
intRow = intRow + intConstMaxBatchSize ' increment intRow by intConstMaxBatchSize
Wend
' Delete the last 'UNION AlL' replacing it with brackets to mark the end of the last insert
Application.Goto Reference:="R" & CStr(intLastRow) & "C" & CStr(intlastColumn + intFormulaCount)
ActiveCell.Value = Replace(ActiveCell.Value, " UNION ALL ", " ) a")
' Select all the formula cells
ActiveCell.Offset(-intLastRow + 2, 1 - intFormulaCount).Range("A1:" & fn_ColLetter(intFormulaCount + 1) & CStr(intLastRow - 1)).Select
Else ' *** No Header Row ***
Application.Goto Reference:="R3" & "C" & CStr(intlastColumn + 1) ' Goto next column in first data row of selection
strFormula(intFormulaCount) = "= ""SELECT "
For intColumn = 1 To intlastColumn
If strDataType(intColumn) = "DATETIME" Then
strCellRef = "Text(" & fn_ColLetter(intColumn) & "3,""dd-mmm-yyyy hh:mm:ss"")" ' Format Excel dates into a text Date format that SQL will pick up
ElseIf strDataType(intColumn) = "VARCHAR(1000)" Then
strCellRef = "SUBSTITUTE(" & fn_ColLetter(intColumn) & "3,""'"",""''"")" ' Change all single ' to double ''
Else
strCellRef = fn_ColLetter(intColumn) & "3"
End If
' Since no column headers: Name each column "Column001",Column002"..
strFormula(intFormulaCount) = strFormula(intFormulaCount) & "CAST('""& " & strCellRef & " & ""' AS " & strDataType(intColumn) & ") AS [Column" & CStr(intColumn) & "]"
If intColumn < intlastColumn Then
strFormula(intFormulaCount) = strFormula(intFormulaCount) + ", "
Else
strFormula(intFormulaCount) = strFormula(intFormulaCount) + " UNION ALL """
End If
' since each cell can only hold a maximum no. of chars if Formula string gets too big continue formula in adjacent cell
If Len(strFormula(intFormulaCount)) > 700 And intColumn < intlastColumn Then
strFormula(intFormulaCount) = strFormula(intFormulaCount) + """"
intFormulaCount = intFormulaCount + 1
strFormula(intFormulaCount) = "= """
End If
Next intColumn
' Assign the formula to the cell(s) just right of the selection
For intColumn = 1 To intFormulaCount
ActiveCell.Value = strFormula(intColumn)
If intColumn < intFormulaCount Then ActiveCell.Offset(0, 1).Range("A1").Select ' Goto next column
Next intColumn
' Auto Fill the formula for the full length of the selection
ActiveCell.Offset(0, -intFormulaCount + 1).Range("A1:" & fn_ColLetter(intFormulaCount) & "1").Select
If intLastRow > 4 Then Selection.AutoFill Destination:=Range(fn_ColLetter(intlastColumn + 1) & "3:" & fn_ColLetter(intlastColumn + intFormulaCount) & CStr(intLastRow)), Type:=xlFillDefault
' Go to start row of data selection to add 'Select into' code
ActiveCell.Value = "SELECT * INTO " & strSQLTableName_Encap & " FROM (" & ActiveCell.Value
' Go to cells above data to insert code for deleting old table with the same name in separate SQL batch
ActiveCell.Offset(-1, 0).Range("A1").Select ' go to the row above
ActiveCell.Value = "GO"
ActiveCell.Offset(-1, 0).Range("A1").Select ' go to the row above
If Left(strSQLTableName, 1) = "#" Then ' temp table
ActiveCell.Value = "IF OBJECT_ID('tempdb.." & strSQLTableName & "') IS NOT NULL DROP TABLE " & strSQLTableName_Encap
Else
ActiveCell.Value = "IF OBJECT_ID('" & strSQLTableName & "') IS NOT NULL DROP TABLE " & strSQLTableName_Encap
End If
' For Big selections (i.e. serveral 100 or 1000 rows) SQL Server takes a very long time to do a multiple union - Split up the table creation into many inserts
intRow = intConstMaxBatchSize + 3 ' add 3 to make sure 1st batch = Max Batch Size
While intRow < intLastRow
Application.Goto Reference:="R" & CStr(intRow - 1) & "C" & CStr(intlastColumn + intFormulaCount) ' Goto Row before intRow and the last column in formula selection
ActiveCell.Value = Replace(ActiveCell.Value, " UNION ALL ", " ) a") ' Remove last 'UNION ALL'
Application.Goto Reference:="R" & CStr(intRow) & "C" & CStr(intlastColumn + 1) ' Goto intRow and the first column in formula selection
ActiveCell.Value = "INSERT " & strSQLTableName_Encap & " SELECT * FROM (" & ActiveCell.Value
intRow = intRow + intConstMaxBatchSize ' increment intRow by intConstMaxBatchSize
Wend
' Delete the last 'UNION AlL'
Application.Goto Reference:="R" & CStr(intLastRow) & "C" & CStr(intlastColumn + intFormulaCount)
ActiveCell.Value = Replace(ActiveCell.Value, " UNION ALL ", " ) a")
' Select all the formula cells
ActiveCell.Offset(-intLastRow + 1, 1 - intFormulaCount).Range("A1:" & fn_ColLetter(intFormulaCount + 1) & CStr(intLastRow)).Select
End If
' Final Selection to clipboard and Cleaning of data
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False ' Repaste "Values Only" back into cells
Selection.Replace What:="CAST('' AS", Replacement:="CAST(NULL AS", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False ' convert all blank cells to NULL
Selection.Replace What:="'00-Jan-1900 00:00:00'", Replacement:="NULL", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False ' convert all blank Date cells to NULL
Selection.Replace What:="'NULL'", Replacement:="NULL", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False ' convert all 'NULL' cells to NULL
Selection.Replace What:=vbTab, Replacement:=" ", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False ' Replace all Tabs in cells to Space to prevent Double Quotes occuring in the final paste text
Selection.Copy
MsgBox "SQL Code has been added to clipboard - Please Paste into SSMS window", vbOKOnly, "Transfer to SQL"
Application.DisplayAlerts = False ' Temporarily switch off Display Alerts
ActiveWindow.Close ' Delete newly created worksheet
Application.DisplayAlerts = True ' Switch display alerts back on
End Sub
Function fn_ColLetter(Col As Integer) As String
Dim strColLetter As String
If Col > 26 Then
' double letter columns
strColLetter = Chr(Int((Col - 1) / 26) + 64) & _
Chr(((Col - 1) Mod 26) + 65)
Else
' single letter columns
strColLetter = Chr(Col + 64)
End If
fn_ColLetter = strColLetter
End Function
The simplest way is to create a computed column in XLS that would generate the syntax of the insert statement.
Then copy these insert into a text file and then execute on the SQL.
The other alternatives are to buy database connectivity add-on's for Excel and write VBA code to accomplish the same.
I'd think some datbases can import data from CSV (comma separated values) files, wich you can export from exel. Or at least it's quite easy to use a csv parser (find one for your language, don't try to create one yourself - it's harder than it looks) to import it to the database.
I'm not familiar with MS SQL but it wouldn't suprise me if it does support it directly.
In any case I think the requrement must be that the structure in the Exel sheet and the database table is similar.
If the interface works the way it did last I used it, you can select the region in Excel, copy it, open SQL Server and paste the data into the table as you would with Access.
Or you could setup an ODBC link between Excel and SQL Server.
why not just use export/import wizard in SSMS?
Can't you use VBA code to do the copy from excel and paste into SSMS operations?