code used for ms access......
Sub gennum()
Dim acc As New Access.Application
Dim wb2 As Workbook
Dim usrname As String
Set wb2 = ThisWorkbook
Application.ScreenUpdating = False
acc.OpenCurrentDatabase "S:\TMS Quotes\TMS Quote.accdb"
With Worksheets("quote number")
.Activate
Range("D4").Select
Selection.ListObject.QueryTable.refresh BackgroundQuery:=False
Selection.Copy
End With
With Worksheets("summary")
.Activate
Range("D10").Select
ActiveSheet.Paste
End With
Application.CutCopyMode = False
usrname = Environ("username")
Range("usrname").Value = usrname
'acc.OpenCurrentDatabase "S:\TMS Quotes\TMS Quote.accdb"
acc.DoCmd.TransferSpreadsheet _
acImport, _
acSpreadsheetTypeExcel12Xml, _
"index", _
Application.ActiveWorkbook.FullName, _
True, _
"index$A1:y2"
acc.CloseCurrentDatabase
acc.Quit
Set acc = Nothing
booktosave
End Sub
code im trying to get to work for SQL...
Sub upload()
Dim cnn As ADODB.Connection
Dim strConnectionString As String
Dim sh As Worksheet
Dim strInsert As String
Dim lngRow As Long
Set sh = Sheets("index")
Set cnn = New ADODB.Connection
'strConnectionString = "Provider=SQLOLEDB.1;User ID=xx; password=xxxxxx!;Initial Catalog=xxxxx;Data Source=Wassim-xxxxxx;"
strConnectionString = "Provider=SQLOLEDB.1;Password=*********;Persist Security Info=True;User ID=******;Initial Catalog=TMSQuote;Data Source=******com.au;"
'Start
cnn.Open strConnectionString
strInsert = "INSERT INTO index (Qnumber, Margin) VALUES (" & -rs2.Field(Sheets("index").Range("a1")).Value & ", " & -rs2.Field(Sheets("index").Range("a2")).Value & ");"
Debug.Print strInsert
CurrentDb.Execute strInsert, dbFailonerror
'tried this code also............................
'For lngRow = 2 To LastUsedCell("d")
'strInsert = "INSERT INTO index ([Qnumber], [Margin], [Dis], [ValueEx]) " & _
' " VALUES (" & _
'sh.Cells(lngRow, 1) & ", " & _
'sh.Cells(lngRow, 2) & ", " & _
' sh.Cells(lngRow, 3) & ", " & _
' "'" & sh.Cells(lngRow, 4) & "')"
'" VALUES ([" & _
'sh.Cells(lngRow, 1) & "] , [" & _
' sh.Cells(lngRow, 2) & "] , [" & _
'sh.Cells(lngRow, 3) & "] , " & _
'"'" & sh.Cells(lngRow, 4) & "')"
' Debug.Print strInsert
'On Error Resume Next
'cnn.Execute strInsert
'Next lngRow
End Sub