David, Thanks for the website, I have tried it and for some reason doesnt
send any data to the table I want it to. It seems to make connection and tell
me that it has uploaded the data, but when checking it, the table in Access
is still empty.

Not sure what I have done wrong. Ignore the previous thread as I was trying
something else that doesnt work at all.

This is the code I have tried.

Code A
Private Sub cmdUpload_Click()
Dim currArcRow As Long
Dim lngRow As Long
Dim rngDataUpload As Range
Dim rngCurr As Range
Set rngCurr = Sheets("Uploaded").Range("A2:A65536")
Dim rngArc As Range
Dim lngIErr As Long ' adds all err numbers together. If no errors occur
then this number is 0
Dim adoRSToArchive As ADODB.Recordset

currArcRow = Module1.findLastRow(rngCurr, "")
If adoRSToSend.RecordCount < 1 Then
MsgBox "Currently Nothing To Upload", vbCritical, "Uploading Data"
Else
Dim optInt As Integer
optInt = MsgBox("Are You Sure You Want To Upload?" & vbCrLf & vbCrLf & _
"You Cannot Make Any Changes To Uploaded Data.", vbYesNo, "Uploading
Data")
If optInt = vbYes Then
lngRow = findLastRow(Sheets("ToSend").Range("A2"), "")
Set rngDataUpload = Sheets("ToSend").Range("A2:P" + CStr(lngRow))
lngIErr = lngIErr + submitPDRInfo(rngDataUpload, "INSERT into tblPDR
(PDRID,ManagerID,Manager,PayID,EmpName,PDRDate,Cre ateDate,KPI1Val,KPI1Score,KPI2Val,KPI2Score,KPI3Va l,KPI3Score,KPI4Val,KPI4Score,Payment,SubmittedBy) " & _

"Values (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,'" + fOSUserName() + "');")
If lngIErr < 0 Then lngIErr = 1
' if no errors in upload move all data to archive
If lngIErr = 0 Then
Set rngDataUpload = Sheets("ToSend").Range("A2:P" + CStr(lngRow))
Set rngArc = Sheets("Uploaded").Range("A" + CStr(currArcRow + 1))
rngDataUpload.Copy rngArc
'rngDataUpload.ClearContents
Set adoRSToArchive = copyToRecordset(rngDataUpload)
rngDataUpload.Copy rngArc
'rngDataUpload.ClearContents
Set adoRSToArchive = copyToRecordset(rngDataUpload)
MsgBox "Data Uploaded", vbInformation, "Uploading Data"
Else
MsgBox "Upload Has Failed", vbCritical, "Uploading Data"
End If
End If
End If
ThisWorkbook.Save
init
End Sub

Public Sub init()
Dim lngRow As Long
lngRow = findLastRow(Sheets("ToSend").Range("A2"), "") + 1
Set rangeObj = Sheets("ToSend").Range("A1:P" + CStr(lngRow))
Set adoRSToSend = copyToRecordset(rangeObj)
Set rangeObj = Sheets("ToSend").Range("A1:P" + CStr(lngRow))
Set adoRSToSend_ = copyToRecordset(rangeObj)
If adoRSToSend_.RecordCount <= 1 Then
Me.TextBox1 = 0
Else
Me.TextBox1 = adoRSToSend_.RecordCount
End If
lngRow = findLastRow(Sheets("ToSend").Range("A2"), "") + 1
lngRow = findLastRow(Sheets("Uploaded").Range("A2"), "") + 1
Set rangeObj = Sheets("Uploaded").Range("A1:P" + CStr(lngRow))
Set adoRSSent = copyToRecordset(rangeObj)
Set rangeObj = Sheets("Uploaded").Range("A1:P" + CStr(lngRow))
Set adoRSSent_ = copyToRecordset(rangeObj)
Set rngObjNew = ThisWorkbook.Sheets("Lookups").Range("A1").End(xlD own)
Set rangeObj = Sheets("Lookups").Range("A1:C" + CStr(rngObjNew.Row))
Set adoRSIM = copyToRecordset(rangeObj)
Set rngObjNew = Nothing
Set rngObjNew = ThisWorkbook.Sheets("Lookups").Range("E1").End(xlD own)
Set rangeObj = Sheets("Lookups").Range("E1:H" + CStr(rngObjNew.Row))
Set rngObjNew = Nothing
Set adoRSEngi = copyToRecordset(rangeObj)
End Sub

Code B

Function submitPDRInfo(shtRng As Range, pInsQry As String) As Long
Dim con As ADODB.Connection, rs As ADODB.Recordset, r As Long
' connect to the Access database
Set con = New ADODB.Connection
con.Open "Provider=Microsoft.Jet.OLEDB.4.0; " & _
"Data Source=D:\Work\BonusMatrix\BonusReviews.mdb;"
' open a recordset
Set rs = New ADODB.Recordset
rs.Open "tblPDR", con, adOpenKeyset, adLockOptimistic, adCmdTable
' all records in a table
r = 2 ' the start row in the worksheet
Do While Len(Range("A" & r).Value) 0
' repeat until first empty cell in column A
With rs
.AddNew ' create a new record
.Fields("PDRID") = Range("A" & r).Value
.Fields("ManagerID") = Range("B" & r).Value
.Fields("Manager") = Range("C" & r).Value
.Fields("PayID") = Range("D" & r).Value
.Fields("EmpName") = Range("E" & r).Value
.Fields("PDRDate") = Range("F" & r).Value
.Fields("CreateDate") = Range("G" & r).Value
.Fields("KPI1Val") = Range("H" & r).Value
.Fields("KPI1Score") = Range("I" & r).Value
.Fields("KPI2Val") = Range("J" & r).Value
.Fields("KPI2Score") = Range("K" & r).Value
.Fields("KPI3Val") = Range("L" & r).Value
.Fields("KPI3Score") = Range("M" & r).Value
.Fields("KPI4Val") = Range("N" & r).Value
.Fields("KPI4Score") = Range("O" & r).Value
.Fields("Payment") = Range("P" & r).Value
.Fields("SubmittedBy") = Value.fOSUserName()
.Update ' stores the new record
End With
r = r + 1 ' next row
Loop
rs.Close
Set rs = Nothing
con.Close
Set con = Nothing
End Function

I cant see where its going wrong, How can I fix this? or even make it far
simpler. My main objective is that I have a userform in excel and on there is
a button which i want to click and then that sends data previously saved in
the report to a database for storage.

Jez





"David Sisson" wrote:

http://www.erlandsendata.no/english/...badacexportado