vba to access

[buddyel]

The code below pulls the data from the database but it also pulls the field headings, along with all the records from the database. I cant seem to change the .Open "Select" statement to make it work right. The tablename is tblEngdata, the fieldname should be dwgno and the criteria should be Range("b8&quot because I only want to retrieve the fields for that record. Also it puts all the data in a single row. I need to have certain fields inserted into certain cells, actually the same way my save macro works. At the very end is my subroutine to save to the DB which works great, and shows how my fields are configured. If anyone could help I would really appreciate it. Thanks.

Sub ADOImportFromAccessTable(DBFullName As String, TableName As String, TargetRange As Range)

Dim cn As ADODB.Connection, rs As ADODB.Recordset, intColIndex As Integer
Set TargetRange = TargetRange.Cells(1, 1)
' open the database
Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & DBFullName & ";"
Set rs = New ADODB.Recordset
With rs
' open the recordset
.Open TableName, cn, adOpenStatic, adLockOptimistic, adCmdTable ' all records
'.Open "SELECT * FROM " & TableName & " WHERE [FieldName] = 'MyCriteria'", cn, , , adCmdText ' filter records

RS2WS rs, TargetRange ' write data from the recordset to the worksheet


End With
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub

Sub RS2WS(rs As ADODB.Recordset, TargetCell As Range)
Dim f As Integer, r As Long, c As Long
If rs Is Nothing Then Exit Sub
If rs.State <> adStateOpen Then Exit Sub
If TargetCell Is Nothing Then Exit Sub

With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
.StatusBar = &quot;Writing data from recordset...&quot;
End With

With TargetCell.Cells(1, 1)
r = .Row
c = .Column
End With

With TargetCell.Parent
.Range(.Cells(r, c), .Cells(.Rows.Count, c + rs.Fields.Count - 1)).Clear ' clear existing contents
' write column headers
For f = 0 To rs.Fields.Count - 1
On Error Resume Next
.Cells(r, c + f).Formula = rs.Fields(f).Name
On Error GoTo 0
Next f
' write records
On Error Resume Next
rs.MoveFirst
On Error GoTo 0
Do While Not rs.EOF
r = r + 1
For f = 0 To rs.Fields.Count - 1
On Error Resume Next
.Cells(r, c + f).Formula = rs.Fields(f).Value
On Error GoTo 0
Next f
rs.MoveNext
Loop
.Rows(TargetCell.Cells(1, 1).Row).Font.Bold = True
.Columns(&quot;A:IV&quot.AutoFit
End With

With Application
.StatusBar = False
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub

Sub StartHere()
ADOImportFromAccessTable &quot;e:\engdata.mdb&quot;, &quot;tblEngdata&quot;, Range(&quot;B8&quot
End Sub




Sub ADOFromExcelToAccess()
' exports data from the active worksheet to a table in an Access database
Dim cn As ADODB.Connection, rs As ADODB.Recordset, r As Long

Dim ExistingRecord As Boolean
Dim prmptUser As Long
Dim lngPos As Long

' connect to the Access database
Set cn = New ADODB.Connection
cn.Open &quot;Provider=Microsoft.Jet.OLEDB.4.0; Data Source=e:\Development\Databases\engdata.mdb&quot;
' open a recordset
Set rs = New ADODB.Recordset


rs.Open &quot;Select * from tblEngdata where [dwgno] = '&quot; & Range(&quot;B8&quot.Value & &quot;'&quot;, cn, 3, 3

With rs
If .RecordCount > 0 Then
ExistingRecord = True
Else
ExistingRecord = False
End If
If ExistingRecord = True Then
prmptUser = MsgBox(&quot;Record already exists - Overwrite Record ?&quot;, vbYesNo + vbQuestion, &quot;What to do ?&quot
If prmptUser = vbYes Then
'Overwrite
.Fields(&quot;dwgno&quot = Range(&quot;b8&quot.Value
.Fields(&quot;rev&quot = Range(&quot;b9&quot.Value
.Fields(&quot;rodno&quot = Range(&quot;b10&quot.Value
.Fields(&quot;rodno2&quot = Range(&quot;b11&quot.Value
.Fields(&quot;sl1&quot = Range(&quot;b12&quot.Value
.Fields(&quot;rodsperhtr&quot = Range(&quot;b13&quot.Value
.Fields(&quot;ceone1&quot = Range(&quot;b14&quot.Value
.Fields(&quot;cetwo1&quot = Range(&quot;b15&quot.Value
.Fields(&quot;addlinfo&quot = Range(&quot;b16&quot.Value
.Fields(&quot;strip1&quot = Range(&quot;b17&quot.Value
.Fields(&quot;strip2&quot = Range(&quot;b18&quot.Value
.Fields(&quot;elemwatts&quot = Range(&quot;b19&quot.Value
.Fields(&quot;elemvolts&quot = Range(&quot;b20&quot.Value
.Fields(&quot;ohms&quot = Range(&quot;b21&quot.Value
.Fields(&quot;amps&quot = Range(&quot;b22&quot.Value
.Fields(&quot;spcstampinfo&quot = Range(&quot;b23&quot.Value
.Fields(&quot;rodelong&quot = Range(&quot;b24&quot.Value
.Fields(&quot;pinelong&quot = Range(&quot;b25&quot.Value
.Fields(&quot;resisfactor&quot = Range(&quot;b26&quot.Value
.Fields(&quot;pinext&quot = Range(&quot;b27&quot.Value
.Fields(&quot;watttolp&quot = Range(&quot;b28&quot.Value
.Fields(&quot;watttolm&quot = Range(&quot;b29&quot.Value
.Fields(&quot;coldohmfactor&quot = Range(&quot;b30&quot.Value
.Fields(&quot;annealtype&quot = Range(&quot;b31&quot.Value
.Fields(&quot;note1&quot = Range(&quot;b32&quot.Value
.Fields(&quot;note2&quot = Range(&quot;b33&quot.Value
.Fields(&quot;note3&quot = Range(&quot;b34&quot.Value
.Fields(&quot;spcroddata&quot = Range(&quot;b35&quot.Value
.Fields(&quot;totalpower&quot = Range(&quot;b39&quot.Value
.Fields(&quot;ph&quot = Range(&quot;b40&quot.Value
.Fields(&quot;totalvolts&quot = Range(&quot;b41&quot.Value
.Fields(&quot;expterminfo&quot = Range(&quot;b43&quot.Value
.Fields(&quot;pinext&quot = Range(&quot;b44&quot.Value
.Fields(&quot;headpinlgth&quot = Range(&quot;b47&quot.Value
.Fields(&quot;tailpinlgth&quot = Range(&quot;b48&quot.Value
.Fields(&quot;rodratio&quot = Range(&quot;c10&quot.Value
.Fields(&quot;sl2&quot = Range(&quot;c12&quot.Value
.Fields(&quot;ceone2&quot = Range(&quot;c14&quot.Value
.Fields(&quot;cetwo2&quot = Range(&quot;c15&quot.Value
.Fields(&quot;dia&quot = Range(&quot;c47&quot.Value
.Update
Else
'Cancel
Exit Sub
End If
Else
.AddNew 'creates a new record
.Fields(&quot;dwgno&quot = Range(&quot;b8&quot.Value
.Fields(&quot;rev&quot = Range(&quot;b9&quot.Value
.Fields(&quot;elemwatts&quot = Range(&quot;b19&quot.Value
.Fields(&quot;elemvolts&quot = Range(&quot;b20&quot.Value
.Fields(&quot;ohms&quot = Range(&quot;b21&quot.Value
.Fields(&quot;amps&quot = Range(&quot;b22&quot.Value
.Fields(&quot;note1&quot = Range(&quot;b32&quot.Value
.Fields(&quot;note2&quot = Range(&quot;b33&quot.Value
.Fields(&quot;note3&quot = Range(&quot;b34&quot.Value
.Fields(&quot;spcroddata&quot = Range(&quot;b35&quot.Value
.Fields(&quot;totalpower&quot = Range(&quot;b39&quot.Value
.Fields(&quot;ph&quot = Range(&quot;b40&quot.Value
.Fields(&quot;totalvolts&quot = Range(&quot;b41&quot.Value
.Fields(&quot;pinext&quot = Range(&quot;b44&quot.Value
.Fields(&quot;headpinlgth&quot = Range(&quot;b47&quot.Value
.Fields(&quot;tailpinlgth&quot = Range(&quot;b48&quot.Value
.Fields(&quot;rodratio&quot = Range(&quot;c10&quot.Value
.Fields(&quot;sl2&quot = Range(&quot;c12&quot.Value
.Fields(&quot;ceone2&quot = Range(&quot;c14&quot.Value
.Fields(&quot;cetwo2&quot = Range(&quot;c15&quot.Value
.Fields(&quot;dia&quot = Range(&quot;c47&quot.Value
.Update
End If
End With
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub