Hi Guys,
I've adapted some code I found which works and allows me to import data from my access table "Device Text" to a specific range in an existing excel worksheet by copying a field "TextEdit" in the recordset. the code is placed in a module behind a command button on an excel worksheet. I have used import to excel because this seems to be less complicated for my needs than exporting from access.
Everything works fine if a single range is set , however I would like to set the range(rng) criteria in the code below to start at a certain cell depending on the value in another field in my access table called "LoopID" this is a number field which is not unique and can be 1,2,3 or 4. I know it wont be evaluated but I've entered the gist in red in my code to give you an idea. I'm self teaching and can use basic code but I'm not sure how to approach this.
I don't need to import it but I suspect I have to bring LoopID into the recordset somehow to use it,
Thanks in advance
I've adapted some code I found which works and allows me to import data from my access table "Device Text" to a specific range in an existing excel worksheet by copying a field "TextEdit" in the recordset. the code is placed in a module behind a command button on an excel worksheet. I have used import to excel because this seems to be less complicated for my needs than exporting from access.
Everything works fine if a single range is set , however I would like to set the range(rng) criteria in the code below to start at a certain cell depending on the value in another field in my access table called "LoopID" this is a number field which is not unique and can be 1,2,3 or 4. I know it wont be evaluated but I've entered the gist in red in my code to give you an idea. I'm self teaching and can use basic code but I'm not sure how to approach this.
I don't need to import it but I suspect I have to bring LoopID into the recordset somehow to use it,
Thanks in advance
Code:
'DIM STATEMENTS
Dim strMyPath As String, strDBName As String, strDB As String, strSQL As String
Dim i As Long, n As Long, lFieldCount As Long
Dim rng As Range
'instantiate an ADO object using Dim with the New keyword:
Dim adoRecSet As New ADODB.Recordset
Dim connDB As New ADODB.Connection
'--------------
'THE CONNECTION OBJECT
strDBName = "C:\Users\graha_000\Desktop\Projects Database Working and most recent Backup\Projects Database 22-02-15.accdb"
strMyPath = "C:\Users\graha_000\Desktop\Protec X400 Excel Text Editor.xls"
strDB = strMyPath & "\" & strDBName
'Connect to a data source:
connDB.Open ConnectionString:="Provider = Microsoft.ACE.OLEDB.12.0; data source=" & strDBName
'--------------
'OPEN RECORDSET, ACCESS RECORDS AND FIELDS
Dim ws As Worksheet
'set the worksheet:
Set ws = ActiveWorkbook.Sheets("Text")
'Set the ADO Recordset object:
Set adoRecSet = New ADODB.Recordset
'Opening the table named SalesManager:
strTable = "DeviceText"
'--------------
'copy all records from the selected fields (TextEdit):
strSQL = "SELECT TextEdit FROM DeviceText"
adoRecSet.Open Source:=strSQL, ActiveConnection:=connDB, CursorType:=adOpenDynamic, LockType:=adLockOptimistic
[COLOR=red]If LoopID = 1 Then
Set rng = ws.Range("C10")
lFieldCount = adoRecSet.Fields.Count
If LoopID = 2 Then
Set rng = ws.Range("C138")
lFieldCount = adoRecSet.Fields.Count
If LoopID = 3 Then
Set rng = ws.Range("C266")
lFieldCount = adoRecSet.Fields.Count
If LoopID = 4 Then
Set rng = ws.Range("C394")
[/COLOR][COLOR=red]lFieldCount = adoRecSet.Fields.Count
End If
End If
End If
End If
[/COLOR]'copy column names in first row of the worksheet:
'rng.Offset(0, i).Value = adoRecSet.Fields(i).Name
'Next i
'copy record values starting from second row of the worksheet:
rng.Offset(0, 0).CopyFromRecordset adoRecSet
'select a column range:
Range(ws.Columns(1), ws.Columns(lFieldCount)).AutoFit
adoRecSet.Close
'copy record values starting from second row of the worksheet:
'rng.Offset(0, 0).CopyFromRecordset adoRecSet
'to copy 4 rows and 3 columns of the recordset to excel worksheet:
'rng.Offset(1, 0).CopyFromRecordset Data:=adoRecSet, MaxRows:=4, MaxColumns:=3
'select a column range:
'Range(ws.Columns(1), ws.Columns(lFieldCount)).AutoFit
'worksheet columns are deleted because this code is only for demo:
'Range(ws.Columns(1), ws.Columns(lFieldCount)).Delete
'adoRecSet.Close
'--------------
Last edited by a moderator: